;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** GARBAGE COLLECTOR AND ALLOCATION STUFF **
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1980 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************




	PGBOT GC


SUBTTL	GRABBAGE COLLECTORS AND RELATED ITEMS


GCRET:	TDZA A,A	;GC WITH NORET=NIL
GCNRT:	MOVEI A,TRUTH	;GC WITH NORET=T
	HRRI T,UNBIND	;EXPECTS FLAG IN LH OF T
	PUSH P,T
	JSP T,SPECBIND
	0 A,VNORET
	JRST AGC


GC:	PUSH P,[333333,,FALSE]	;SUBR 0 - USER ENTRY TO GC
	JRST AGC		;TO UNDERSTAND THE 3'S, SEE GSTRT7


MINCEL==6*NFF	;MIN NUMBER WORDS TO RECLAIM FOR EACH SPACE
IFG 40-MINCEL, MINCEL==40

IFN KA10+KI10,[
GCCNT:				;FREELIST COUNTING LOOP TO RUN IN AC'S
OFFSET -.
	NIL			;SO THAT THE FOLLOWING INS WILL STOP ON NIL
GCCNT1:	SKIPE TT,(TT)
GCCNT4:	 AOJA GCCNT0,.-1	;OR MAYBE AOBJN
	JRST GCP4A
LPROG3==:.-1
GCCNT0:
OFFSET 0
.HKILL GCCNT1 GCCNT4 GCCNT0
]		;END OF IFN KA10+KI10
IFN KL10,[
GCCNT1:	SKIPE VGCDAEMON		;FREELIST COUNTING LOOP
	 JRST GCCNT6
	SKIPE TT,(TT)
	 AOBJN GCCNT0,.-1	;SHORT ONE FOR JUST SEEING WHETHER >MINCEL
	JRST GCP4A

GCCNT6:	SKIPE TT,(TT)
	 AOJA GCCNT0,.-1	;LONG ONE FOR COUNTING FOR GCDAEMON
	JRST GCP4A

GCCNT0==:AR1
]		;END OF IFN KL10

SUBTTL	GC - INITIALIZATION

WHL==:USELESS*ITS		;FLAG FOR WHO-LINE STUFF

   XCTPRO
AGC4:	HRROS NOQUIT		;ENTRY FROM FWCONS, FLCONS, AND THE LIKE
   NOPRO
	SUBI A,2		;ENTER WITH  JSP A,AGC4
	PUSH P,A
   XCTPRO
AGC:	HRROS NOQUIT		;ENTER HERE WITH  PUSHJ P,AGC
   NOPRO
	SKIPE ALGCF		;CANT SUCCESSFULLY GC WHILE IN ALLOC
	 JRST ALERR
AGC1:
;MUST HAVE DONE  HRROS NOQUIT  BEFORE COMING HERE.
;FIRST WE GET CURRENT RUNTIME IN "HOST MACHINE UNITS" IN GCTM1.
;THIS MUST BE DONE IN AND AROUND THE SAVING OF THE AC'S.
IT$	.SUSET [.RRUNT,,GCTM1]
	MOVEM NACS+1,GCNASV
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,		;GET RUNTIME FOR THIS JOB
10$	MOVEM NACS+1,GCTM1
	MOVEI NACS+1,GCACSAV
	BLT NACS+1,GCACSAV+NACS	;BLT AWAY ARG ACS (AND NIL) INTO PROTECTED PLACE
20$	MOVEI 1,.FHSLF
20$	RUNTM			;GET RUNTIME FOR THIS FORK
20$	MOVEM 1,GCTM1
	MOVE NACS+1,[NACS+2,,GCNASV+1]
	BLT NACS+1,GCNASV+16-<NACS+1>	;SAVE NON-MARKED AC'S EXCEPT SP
	MOVE NACS+1,[UUOH,,GCUUSV]
	BLT NACS+1,GCUUSV+LUUSV-1	;SAVE UUOH STUFF, IN CASE STRT IS USED
	MOVEI A,TRUTH			;SPECBIND TERPRI TO T, TO PREVENT
	JSP T,SPECBIND			; AUTO-TERPRI IN GC MESSAGES
	   0 A,V%TERPRI
	MOVEM SP,GCNASV+17-<NACS+1>	;NOW SAVE SP
	SETZM GCFXP
	SETZ R,
REPEAT NFF,[
	SKIPN FFS+.RPCNT	;FIGURE OUT WHICH SPACE(S) EMPTY
	 TLO R,400000←-.RPCNT
]		;END OF REPEAT NFF
	SKIPN FFY2			;IF WE RAN OUT OF SYMBOL BLOCKS,
	 TLO R,400000←<-FFY+FFS>	; THEN CREDIT IT TO SYMBOLS
	MOVN D,R		;THIS IS A STANDARD HACK TO KILL ONE BIT
	TDZE R,D		;SKIP IF THERE WERE NO BITS
	 JUMPE R,GCGRAB		;JUMP IF EXACTLY ONE BIT ON
AGC1Q:	SETZM GCRMV
	AOSE IRMVF	;IF OVERRIDE IS ON, THEN
	 SKIPE VGCTWA
	  SETOM GCRMV		;DO REMOVAL ANYHOW.
	MOVNI TT,20		;TOP 40 BITS OF WORD ON
	JSP F,GCINBT		;INIT MARK BITS FOR LIST, FIXNUM, ETC.
	MOVE T,[SFSSIZ,,OFSSIZ]	;SAVE AWAY OLD SIZES OF SPACES
	BLT T,OSASIZ		; (USED FOR ARG TO GC-DAEMON)
	MOVE T,VGCDAEMON
	IOR T,GCGAGV
IFE WHL,	JUMPE T,GCP6
IFN WHL,	JUMPE T,GCP5
KAKI	MOVSI R,GCCNT
KAKI	BLT R,LPROG3
KAKI	SKIPN VGCDAEMON
KAKI	HRLI GCCNT4,(AOBJN GCCNT0,)
	MOVNI R,NFF		;MAY OR MAY NOT HAVE BIGNUMS OR HUNKS
GCP4:	SETZ GCCNT0,
	SKIPGE FFS+NFF(R)
	 JRST GCP4B
	SKIPN VGCDAEMON
	 MOVSI GCCNT0,-MINCEL
	SKIPE TT,FFS+NFF(R)
	 AOJA GCCNT0,GCCNT1
GCP4A:	TLZ GCCNT0,-1
	HRRZ F,GCWORN+NFF(R)	;ACCOUNT FOR LENGTHS OF ITEMS
	IMULI GCCNT0,(F)
	CAIGE GCCNT0,MINCEL	;IF LESS THEN MINCEL, THEN FREELIST WAS
	 SETZM FFS+NFF(R)	; "PRACTICALLY EMPTY" AND DESERVES SOME BLAME
GCP4B:	HRLM GCCNT0,NFFS+NFF(R)
	AOJL R,GCP4

;FALLS THROUGH

;FALLS IN

;;;	PDLS ARE SAFE

IFN WHL,[
GCP5:	MOVE F,GCWHO
	SKIPE GCGAGV
	 JRST GSTRT0
	TRNN F,1		;1-BIT MEANS WE WANT TO SEE
	 JRST GCP6		; THE REASON FOR THE GC
	JRST GSTR0A		; IN THE WHO-LINE
]		;END OF IFN WHL
IFE WHL,[
	SKIPN GCGAGV
	 JRST GCP6
]		;END OF IFE WHL
GSTRT0:	STRT 17,[SIXBIT \↑M;GC DUE TO !\]
GSTR0A:	SETZB TT,D		;FIGURE OUT REASON FOR GC
	HLRZ T,(P)
	CAIN T,111111		;WAS IT INITIAL STARTUP? (SEE LISP)
	 MOVEI TT,[SIXBIT \STARTUP!\]
	CAIN T,333333		;WAS IT USER CALLING GC FUNCTION?
	 MOVEI TT,[SIXBIT \USER!\]
	CAIN T,444444		;WAS IT ARRAYS?
	 MOVEI TT,[SIXBIT \ARRAY RELOCATION!\]
	CAIN T,555555		;I/O CHANNELS?
	 MOVEI TT,[SIXBIT \I/O CHANNELS!\]
	CAIN T,666666		;SUSPEND?
	 MOVEI TT,[SIXBIT \SUSPEND!\]
	JUMPN TT,GSTRT8
	MOVNI T,NFF		;NONE OF THOSE HYPOTHESES WORK
GSTRT1:	SKIPN FFS+NFF(T)	;MAYBE SOME STORAGE SPACE RAN OUT
	 SKIPA TT,T
	  ADDI D,1
	AOJL T,GSTRT1
	JUMPE TT,GSTRT7		;NO, THAT WASN'T IT
IFN WHL,	SKIPN GCGAGV
.ALSO,		 JRST GSTRT4
	MOVNI T,NFF		;YES, IT WAS. PRINT MOBY MESSAGE!
	SETZ R,
GSTRT2:	SKIPE FFS+NFF(T)
	 JRST GSTRT5
	JUMPE R,GSTRT3
	CAIE D,NFF-2
	 STRT 17,[SIXBIT \, !\]
	CAMN T,TT
	 STRT 17,[SIXBIT \ AND !\]
GSTRT3:	SETO R,
	STRT 17,@GSTRT9+NFF(T)
GSTRT5:	AOJL T,GSTRT2
	STRT 17,[SIXBIT \ SPACE!\]
	CAIE D,NFF-1
	 STRT 17,[SIXBIT \S!\]
IFN WHL, GSTRT4:	MOVE TT,GSTRT9+NFF(TT)
	JRST GSTRT6


GSTRT7:	MOVEI TT,[SIXBIT \ ? !\]	;I DON'T KNOW WHY WE'RE HERE!
GSTRT8:
IFN WHL,SKIPE GCGAGV
	STRT 17,(TT)		;PRINT REASON

GSTRT6:
IFN WHL,[
	TRNN F,1
	 JRST GCWHL9
	MOVE D,(TT)
	MOVE R,1(TT)
	ROTC D,-22
	MOVSI F,(SIXBIT \!\)
	MOVE T,[220600,,D]
GCWHL2:	ILDB TT,T
	CAIE TT,'!
	 JRST GCWHL2
	DPB NIL,T
GCWHL3:	IDPB NIL,T
	TLNE T,770000
	 JRST GCWHL3
	HRLI D,(SIXBIT \GC:\)
	MOVE T,[-6,,GCWHL6]
	.SUSET T
GCWHL9:
]		;END OF IFN WHL

;FALLS THROUGH

;;;	 PDLS ARE SAFE

SUBTTL	GC - MARK THE WORLD

;FALLS IN

GCP6:	HRROS MUNGP		;STARTING TO MUNG SYMBOL/SAR MARK BITS
	MOVE A,[<-20>←-NUNMRK]	;PRE-PROTECT CERTAIN
	ANDM A,BTBLKS		; RANDOM LIST CELLS
	MOVNI R,NACS+1		;PROTECT CONTENTS OF MARKED ACS
GCP6Q0:	HRRZ A,GCACSAV+NACS+1(R)
	JSP T,GCMARK
	AOJL R,GCP6Q0
	HRRZ R,C2
	ADDI R,1
GCP6Q1:	HRRZ A,(R)		;CAUSES MARKING OF CONTENTS
	JSP T,GCMARK		; OF ACS AT TIME OF GC, AND OF REG PDL
	CAIGE R,(P)
	 AOJA R,GCP6Q1
	MOVEI R,LPROTE-1
GCP6Q2:	MOVEI A,BPROTE(R)	;PROTECT PRECIOUS STUFF
	JSP T,GCMARK
	SOJGE R,GCP6Q2
IFN BIGNUM,[
	MOVEI R,LBIGPRO-1
GCP6Q3:	MOVEI A,BBIGPRO(R)
	JSP T,GCMARK
	SOJGE R,GCP6Q3
]		;END OF IFN BIGNUM
	MOVSI R,TTS<GC>
	IORM R,DEDSAR+TTSAR	;PROTECT DEDSAR
	IORM R,DBM+TTSAR	;PROTECT DEAD BLOCK MARKER
	HRRZ R,SC2
GCP6Q4:	HRRZ A,(R)
	JSP T,GCMARK		;MARK SAVED VALUES ON SPEC PDL
	CAIGE R,(SP)
	 AOJA R,GCP6Q4
	SKIPN R,INTAR
	 JRST GCP6Q6
GCP6Q5:	MOVE A,INTAR(R)
	JSP T,GCMARK
	SOJG R,GCP6Q5
GCP6Q6:				;PROTECT INTERRUPT FUNCTIONS
IRP Z,,[0,1,2]X,,[ALARMCLOCK,AUTFN,UDF]
	MOVEI R,NUINT!Z
	SKIPE A,V!X(R)
	 JSP T,GCMARK
	SOJG R,.-2
TERMIN
	SKIPE A,VMERR
	 JSP T,GCMARK
IFN PAGING,[
	SKIPN D,LHSGLK		;SKIP IF ANY LH SEGMENTS
	 JRST GCP6R0		.SEE LHVBAR
GCP6Q8:	MOVEI F,(D)		;CREATE AOBJN POINTER INTO SEGMENT
	LSH F,SEGLOG
	HRLI F,-SEGSIZ
GCP6Q9:	HLRZ A,(F)		;MARK FROM ALL ENTRIES IN THAT SEGMENT
	JSP T,GCMARK
	HRRZ A,(F)
	JSP T,GCMARK
	AOBJN F,GCP6Q9
	LDB D,[SEGBYT,,GCST(D)]	;FOLLOW LINKED LIST OF SEGMENTS
	JUMPN D,GCP6Q8
GCP6R0:
]		;END OF IFN PAGING

;FALLS THROUGH

;;;	PDLS ARE SAFE

;FALLS IN

	SKIPN GCRMV
	 JRST GCP6B1
	JSP R,GCGEN		;IF DOING TWA REMOVAL, TRY MARKING FROM 
		GCP8I		;NON-TRIVIAL P-LISTS OF CURRENT OBARRAY
	JRST GCP6B2

GCP6B1:	MOVE A,VOBARRAY
	JSP TT,$GCMKAR		;OTHERWISE, JUST MARK OBARRAY BUCKETS
GCP6B2:	MOVEI A,OBARRAY
	CAME A,VOBARRAY
	 JSP TT,$GCMKAR
	MOVE R,GCMKL
GCP6A:	JUMPE R,GCP6D
	HLRZ A,(R)
	MOVE D,ASAR(A)
	TLNN D,AS<GCP>	;IF ARRAY POINTER HAS "GC ME" BIT SET,
	 JRST GCP6F
	TLNE D,AS<OBA>	;MORE CHECKING ON OBARRAYS
	 JRST GCP6F0
GCP6F1:	JSP TT,GCMKAR	; THEN MARK FROM ARRAY ENTRIES
GCP6F:	HRRZ R,(R)
	HRRZ R,(R)
	JRST GCP6A

GCP6F0:	CAMN A,VOBARRAY	; AND IF THIS ISN'T THE CURRENT OBARRAY,
	 SKIPN GCRMV	; OR IT IS, BUT WE ARENT DOING GCTWA REMOVAL,
	  JRST GCP6F1
	JRST GCP6F

GCP6D:	MOVE A,V%TYI
	JSP TT,$GCMKAR
	MOVE A,V%TYO
	JSP TT,$GCMKAR
	SKIPN R,PROLIS
GCP6D1:	 JUMPE R,GCP6H	;PROTECT READ-MACRO
	HLRZ A,(R)	; FUNCTIONS (CAN'T JUST GCMARK WHOLE
	HLRZ A,(A)	; PROLIS - DON'T WANT TO PROTECT
	JSP T,GCMARK	; READTABLE SARS)
	HRRZ R,(R)
	JRST GCP6D1


GSTRT9:	[SIXBIT \LIST!\]	.SEE GCWORRY
	[SIXBIT \FIXNUM!\]	.SEE GCPNT
	[SIXBIT \FLONUM!\]
DB$	[SIXBIT \DOUBLE!\]
CX$	[SIXBIT \COMPLEX!\]
DX$	[SIXBIT \DUPLEX!\]
BG$	[SIXBIT \BIGNUM!\]
	[SIXBIT \SYMBOL!\]
IRP X,,[2,4,8,16,32,64,128,256,512,1024]
	[SIXBIT \HUNK!X!!\]
IFE .IRPCNT-HNKLOG, .ISTOP
TERMIN
	[SIXBIT \ARRAY!\]

IFN WHL,[
GCWHL6:	.RWHO1,,GCWHO1
	.RWHO2,,GCWHO2
	.RWHO3,,GCWHO3
	.SWHO1,,[.BYTE 8 ? 66 ? 0 ? 366 ? 0 ? .BYTE]
	.SWHO2,,D
	.SWHO3,,R
]		;IFN WHL

;;;	PDLS ARE SAFE

SUBTTL	GC - CONSIDER THE EFFECTS OF AN ARRAY DISAPPEARING

;;; UPDATE THE GCMKL BY SPLICING OUT ARRAYS TO BE SWEPT.
;;; IF ANY SUCH ARRAYS ARE OPEN FILES, CLOSE THEM.

CGCMKL:
GCP6H:	SKIPN F,GCMKL
	JRST GCP7
	JSP A,GCP6H0
GCP6H1:	HLRZ A,(F)
	TDNE TT,TTSAR(A)
	JRST GCP6G
	TDNE T,ASAR(A)
	JRST GCP6H7
GCP6H8:
	ANDCAM TT,TTSAR(A)
	IORM R,TTSAR(A)
	MOVEI B,ADEAD
	EXCH B,ASAR(A)
	TLNN B,AS<RDT>
	JRST GCP6G
	MOVEI AR1,PROLIS	;JUST KILLED A READTABLE
GCP6H3:	HRRZ AR2A,(AR1)		; - CLEAN UP PROLIS
GCP6H4:	JUMPE AR2A,GCP6G
	HLRZ C,(AR2A)
	HRRZ C,(C)
	HLRZ C,(C)
	CAIE C,(A)
	JRST GCP6H5
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)
	JRST GCP6H4
GCP6H5:	MOVEI AR1,(AR2A)
	JRST GCP6H3
GCP6G:	HRRZ F,(F)
	HRRZ F,(F)
	JUMPN F,GCP6H1
	JRST GCP7

GCP6H0:	MOVSI T,AS<JOB+FIL>	;SET UP SOME ACS FOR THE GCMKL-LOOK LOOP
	MOVE R,[TTDEAD]
	MOVSI TT,TTS<CN+GC>
	JRST (A)

;;;	PDLS ARE SAFE


;;; CLEAN UP AND CLOSE A FILE WHEN GARBAGE COLLECTED

GCP6H7:	MOVE B,TTSAR(A)		;ABOUT TO GC A FILE ARRAY
	TLNE B,TTS<CL>		;IGNORE IF ALREADY CLOSED
	 JRST GCP6H8
	PUSH P,F
IFN JOBQIO,[
	HLL B,ASAR(A)
	TLNE B,AS<JOB>
	 JRST GCP6J1
]		;END OF IFN JOBQIO
	PUSHJ P,ICLOSE		;OTHERWISE CLOSE THE FILE
	MOVEI R,[SIXBIT \↑M;FILE CLOSED: !\]
GCP6H2:	SKIPN GCGAGV
	 JRST GCP6H9
	STRT 17,(R)
	HLRZ A,@(P)
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	HRROI R,$TYO
	PUSHJ P,PRINTA
GCP6H9:	POP P,F
	JSP A,GCP6H0		;RE-INIT MAGIC CONSTANTS IN ACS
	HLRZ A,(F)
	JRST GCP6H8



IFN JOBQIO,[

;;; CLEAN UP AND CLOSE AN INFERIOR PROCEDURE WHEN GARBAGE COLLECTED

GCP6J1:
IFN ITS,[
	MOVEI R,[SIXBIT \↑M;FOREIGN JOB FLUSHED: !\]
	SKIPN T,J.INTB(B)
	 JRST GCP6J3
	MOVEI R,[SIXBIT \↑M;INFERIOR JOB FLUSHED: !\]
	.CALL GCP6J9		;IF INFERIOR JOB, OPEN IT ON
	 .VALUE			; THE TEMPORARY I/O CHANNEL
	.UCLOSE TMPC,		; AND KILL IT
	JFFO T,.+1
	MOVNS TT
	SETZM JOBTB+21(TT)	;CLEAR ENTRY IN JOB TABLE
]		;END OF IFN ITS
GCP6J3:	MOVSI T,TTS<CL>		;MARK THE JOB OBJECT AS BEING CLOSED
	ANDCAM T,TTSAR(A)
	JRST GCP6H2

IFN ITS,[
GCP6J9:	SETZ
	SIXBIT \OPEN\		;OPEN FILE (INFERIOR PROCEDURE)
	  1000,,TMPC		;CHANNEL NUMBER
	      ,,F.DEV(B)	;DEVICE NAME (USR)
	      ,,F.FN1(B)	;FILE NAME 1 (UNAME)
	400000,,F.FN2(B)	;FILE NAME 2 (JNAME)
]		;END OF IFN ITS

]		;END OF IFN JOBQIO


;;;	PDLS ARE SAFE

SUBTTL	GC - TWA REMOVAL

GCP7:	HRRZ A,GCMKL
	JSP T,GCMARK
	HRRZ A,PROLIS
	JSP T,GCMARK
	SKIPN GCRMV
	JRST GCSWP
	JSP R,GCGEN		;IF DOING TWA REMOVAL, THEN WIPE OUT
	   GCP8G		; T.W.A.'S AND THEN MARK BUCKETS
	MOVE A,VOBARRAY
	JSP TT,$GCMKAR

;FALLS THROUGH

;;;	PDLS ARE UNSAFE

SUBTTL	GC - SWEEP THE WORLD

;FALLS IN

GCSWP:				.SEE KLINIT ;WHICH CLOBBERS NEXT INSTRUCTION
	MOVEM FXP,GCFXP		;WE ARE ABOUT TO CLOBBER THE PDL POINTERS
	MOVNI SP,NFF		;NUMBER OF SPACES TO SWEEP
	MOVEM SP,GC99
;MAJOR SWEEP LOOP OVER ALL SPACES
GCSW1:
IFN KA10+KI10,[
	MOVE FXP,GCSWTB+NFF(SP)	;PUT INNER SWEEP LOOP IN AC'S
	HLLZ FLP,FXP		; AND INITIALIZE COUNT
	BLT FLP,(FXP)
	SETZ FXP,			;FREELIST INITIALLY NIL
]		;END OF IFN KA10+KI10
KL	SETZB A,FXP		;FXP HAS FREELIST, A HAS COUNT
	SKIPN FLP,FSSGLK+NFF(SP)
	 JRST GCSW7
;MINOR SWEEP LOOP OVER ALL SEGMENTS IN A SPACE
GCSW2:	MOVEM FLP,GC98
	JRST @GCSW2A+NFF(SP)	;DISPATCH ON TYPE TO SEPARATE ROUTINES
GCSW2A:	GCSWS			;LIST
	GCSWS			;FIXNUM
	GCSWS			;FLONUM
DB$	GCSWD			;DOUBLE
CX$	GCSWC			;COMPLEX
DX$	GCSWZ			;DUPLEX
BG$	GCSWS			;BIGNUM
	GCSWY			;SYMBOL
IFN HNKLOG, 	GCSWH1
REPEAT HNKLOG,[
IFL .RPCNT-4,	GCSWH1		;HUNKS OF LESS THAN 40 WORDS
.ELSE		GCSWH2		;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GCSWA			;SARS
IFN .-GCSW2A-NFF, WARN [WRONG LENGTH TABLE]

GCSW5:	MOVE SP,GC99
	MOVE FLP,GC98
	LDB FLP,[SEGBYT,,GCST(FLP)]
	JUMPN FLP,GCSW2
GCSW7:
KAKI	HRRZ A,@GCSW7A+NFF(SP)
	HRRM FXP,FFS+NFF(SP)	;SAVE FREELIST - DON'T DISTURB SIGN BIT
	HRRZ B,GCWORN+NFF(SP)
	IMULI A,(B)		;ACCOUNT FOR SIZE OF OBJECTS IN THIS SPACE
	HRRM A,NFFS+NFF(SP)	;SAVE COUNT OF WORDS COLLECTED
	AOSGE SP,GC99
	 JRST GCSW1
	HRRZS MUNGP		;WE HAVE UNDONE MUNGING OF BITS
	MOVSI F,TTS<CN+GC>
	ANDCAM F,DEDSAR		;MUST CLEAR BITS IN DEDSAR
	JSP NACS+1,GCACRS	;RESTORE ACCUMULATORS
	JRST GCPNT		;NEXT PRINT STATISTICS

;;;	PDLS ARE UNSAFE

IFN KA10+KI10,[
;TABLE OF SWEEPERS FOR RUNNING IN ACS AND THE LAST LOCATIONS TO LOAD THEM INTO
GCSWTB:	GCFSSWP,,LPROG1		;LIST
	GCFSSWP,,LPROG1		;FIXNUM
	GCFSSWP,,LPROG1		;FLONUM
DB$	GCHSW1,,LPROGH		;DOUBLE
CX$	GCHSW1,,LPROGH		;COMPLEX
DX$	GCHSW1,,LPROGH		;DUPLEX
BG$	GCFSSWP,,LPROG1		;BIGNUM
	GSYMSWP,,LPROG6		;SYMBOL
IFN HNKLOG,	GCHSW1,,LPROGH	
REPEAT HNKLOG,[
IFL .RPCNT-4,	GCHSW1,,LPROGH	;HUNKS OF LESS THAN 40 WORDS
.ELSE		GCHSW2,,LPROGK	;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GSARSWP,,LPROG4		;SARS
IFN .-GCSWTB-NFF, WARN [WRONG LENGTH TABLE]

;TABLE OF AC FOR EACH SWEEPER WHICH HOLDS COUNT OF OBJECTS SWEPT
GCSW7A:	GFSCNT			;LIST
	GFSCNT			;FIXNUM
	GFSCNT			;FLONUM
DB$	GHCNT1			;DOUBLE
CX$	GHCNT1			;COMPLEX
DX$	GHCNT1			;DUPLEX
BG$	GFSCNT			;BIGNUM
	GYCNT			;SYMBOL
IFN HNKLOG,	GHCNT1	
REPEAT HNKLOG,[
IFL .RPCNT-4,	GHCNT1		;HUNK OF LESS THAN 40 WORDS
.ELSE		GHCNT2		;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GSCNT			;SARS
IFN .-GCSW7A-NFF, WARN [WRONG LENGTH TABLE]

]		;END OF IFN KA10+KI10

;;;	PDLS ARE UNSAFE

GCSWS:	MOVE P,GCST(FLP)	;GET SHIFTED ADDRESS OF BIT BLOCK
	LSH P,SEGLOG-5		;SHIFT BACK TO FORM WORD ADDRESS
	HRLI P,-BTBSIZ		;MAKE AOBJN POINTER OVER WORDS OF BITS
	LSH FLP,SEGLOG
	HRLI FLP,-40		;40 CELLS PER WORD OF BITS
KAKI	JRST GFSP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCFSSWP:			;SWEEPER FOR LIST, FIXNUM, FLONUM, BIGNUM
KAKI OFFSET -.			;RELOCATED TO ACS FOR KA AND KI
GFSP1:	SKIPN SP,(P)		;GET A WORD OF MARK BITS
	 JRST GFSP5		;IF ALL 40 WORDS MARKED, THIS SAVES TIME
GFSP2:	JUMPGE SP,GFSP4		;JUMP IF SINGLE WORD MARKED
	HRRZM FXP,(FLP)		;ELSE CHAIN INTO FREE LIST
	HRRZI FXP,(FLP)
KAKI GFSCNT:	AOJ .,0			;RH COUNTS RECLAIMED CELLS
KL	ADDI A,1
GFSP4:	ROT SP,1		;ROTATE NEXT MARK BIT UP
	AOBJN FLP,GFSP2		;COUNT OFF 40 WORDS
	TLOA FLP,-40		;RESET 40-WORD COUNT IN AOBJN POINTER
GFSP5:	 ADDI FLP,40		;SKIP OVER 40 WORDS IN SWEEP
	AOBJN P,GFSP1		;<BTBSIZ> BLOCKS OF 40 WORDS
	JRST GCSW5
KAKI LPROG1==:.-1
KAKI OFFSET 0
KAKI .HKILL GFSP1 GFSP2 GFSCNT GFSP4 GFSP5


GCSWY:	LSH FLP,SEGLOG
	HRLI FLP,-SEGSIZ
KL	MOVEI GYSP7,(300,,0)	;3.8=PURE, 3.7=COMPILED CODE REFS
KAKI	JRST GYSP1
KL GYSP7==:0
GSYMSWP:			;SWEEPER FOR SYMBOL SPACE
KAKI OFFSET -.
KAKI GYSP7:	(300,,0)	;3.8=PURE, 3.7=COMPILED CODE REFS (NOTE: TSNE WITH ITSELF ALWAYS SKIPS)
GYSP1:	HLRZ SP,(FLP)
	TRZN SP,1		;IF MARKED,
	 TSNE GYSP7,(SP)	; OR IF PURE OR COMPILED CODE NEEDS IT,
	  JRST GYSP3		; THEN DO NOT SWEEP UP
	JUMPN SP,GYSP5		;IF NON-NIL LEFT HALF, RECLAIM THE SYMBOL BLOCK
GYSP2:	HRRZM FXP,(FLP)		;CHAIN ONTO FREELIST
	HRRZI FXP,(FLP)
GYCNT:
KAKI	AOJ .,0
KL	ADDI A,1		;INCREMENT OBJECT COUNT
GYSP3:	HRLM SP,(FLP)
	AOBJN FLP,GYSP1
	JRST GCSW5
KAKI LPROG6==:.-1
KAKI OFFSET 0
KAKI .HKILL GYSP1 GYSP2 GYSP3 GYSP7 GYCNT

;;; PART OF SYMBOL SWEEPER - RESTORES A SYMBOL BLOCK TO FFY2.
;;; ALSO ATTEMPTS TO RETURN THE VALUE CELL IF IT HAS ONE.

GYSP5:	EXCH SP,FFY2		;RETURN SYMBOL BLOCK TO FREELIST
	EXCH SP,@FFY2
	TLZ SP,-1		;MAYBE TRY TO RETURN A VALUE CELL
	CAIE SP,SUNBOUND
	 JRST GYSP5A
	SETZ SP,
	JRST GYSP2

GYSP5A:	CAIL SP,BXVCSG+NXVCSG*SEGSIZ
	 JRST GYSP5B		;CAN ONLY RETURN CELLS IN VC SPACE
	EXCH SP,FFVC
	MOVEM SP,@FFVC
GYSP5B:	SETZ SP,
	JRST GYSP2

;;;	PDLS ARE UNSAFE

IFN HNKLOG+DBFLAG+CXFLAG,[

GCSWD:
GCSWC:
GCSWZ:
GCSWH1:	HRRZ P,GCWORN+NFF(SP)	;GET SIZE OF OBJECTS
KAKI	HRRI GH1SP4,(P)
KL	MOVEI B,(P)
	SUBI P,1
KAKI	HRRI GH1SP5,(P)
KL	MOVEI C,(P)
	HRRZ P,GCWORN+NFF(SP)
	MOVNI SP,40
	IDIVM SP,P
KAKI	HRRI GH1SP6,(P)		;BITS PER BIT BLOCK WORD
KL	MOVEI AR1,(P)
	MOVE P,GCST(FLP)	;GET SHIFTED ADDRESS OF BIT BLOCK
	LSH P,SEGLOG-5		;SHIFT BACK TO FORM WORD ADDRESS
	HRLI P,-BTBSIZ		;MAKE AOBJN POINTER OVER WORDS OF BITS
	LSH FLP,SEGLOG		;MAKE AOBJN POINTER OVER CELLS
KAKI	HRLI FLP,(GH1SP6)
KL	HRLI FLP,(AR1)
KAKI	JRST GH1SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW1:
KAKI OFFSET -.
GH1SP1:	MOVE SP,(P)
GH1SP2:	JUMPGE SP,GH1SP4
	HRRZM FXP,(FLP)
	HRRZI FXP,(FLP)
IFN KA10+KI10,[
GHCNT1:	AOJ .,0
GH1SP4:	ROT SP,1←HNKLOG
GH1SP5:	ADDI FLP,<1←HNKLOG>-1
	AOBJN FLP,GH1SP2
GH1SP6:	HRLI FLP,<-40>←-HNKLOG
]		;END OF IFN KA10+KI10
IFN KL10,[
	ADDI A,1
GH1SP4:	ROT SP,(B)
	ADDI FLP,(C)
	AOBJN FLP,GH1SP2
	HRLI FLP,(AR1)
]		;END OF IFN KL10
	AOBJN P,GH1SP1
	JRST GCSW5
KAKI LPROGH==:.-1
KAKI OFFSET 0
KAKI .HKILL GH1SP1 GH1SP2 GHCNT1 GH1SP4 GH1SP5 GH1SP6

]		;END OF IFN HNKLOG+DBFLAG+CXFLAG

;;;	PDLS ARE UNSAFE

IFG HNKLOG-4,[
GCSWH2:	HRRZ P,GCWORN+NFF(SP)	;GET SIZE OF OBJECTS
KAKI	HRRI GH2SP5,(P)
KL	MOVEI B,(P)
	SUBI P,1
	LSH P,-5
KAKI	HRRI GH2SP7,(P)		;BITS PER BIT BLOCK WORD
KL	MOVEI AR2A,(P)
	HRRZ P,GCWORN+NFF(SP)
	LSH P,-5
	MOVNI SP,BTBSIZ
	IDIVM SP,P
	HRLI P,(P)		;MAKE AOBJN POINTER OVER WORDS OF BITS
	MOVE SP,GCST(FLP)
	LSH SP,SEGLOG-5
	HRRI P,(SP)
	LSH FLP,SEGLOG		;MAKE POINTER OVER CELLS
KAKI	JRST GH2SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW2:
KAKI OFFSET -.
GH2SP1:	SKIPL (P)		;ONLY THE SIGN BIT OF A MARK WORD IS USED
	 JRST GH2SP5
	HRRZM FXP,(FLP)
	HRRZI FXP,(FLP)
IFN KA10+KI10,[
GHCNT2:	AOJ .,0
GH2SP5:	ADDI FLP,1←HNKLOG
GH2SP7:	ADDI P,<<1←HNKLOG>-1>←-5
]		;END OF IFN KA10+KI10
IFN KL10,[
	ADDI A,1
GH2SP5:	ADDI FLP,(B)
	ADDI P,(AR2A)
]		;END OF IFN KL10
	AOBJN P,GH2SP1
	JRST GCSW5
KAKI LPROGK==:.-1
KAKI OFFSET 0
KAKI .HKILL GH2SP1 GH2SP2 GHCNT2 GH2SP5 GH2SP7

]		;END OF IFG HNKLOG-4

GCSWA:	LSH FLP,SEGLOG
	HRLI FLP,-SEGSIZ/2
KL	MOVSI B,(TTS<CN+GC>,,)
KL	MOVSI C,(TTS<GC>,,)
	JRST GSSP1

GSARSWP:			;SPECIAL SWEEPER FOR SARS
KAKI OFFSET -.
GSSP0:	ADDI FLP,1
GSSP1:
KAKI	TDNN GSSP7,TTSAR(FLP)	;TEST IF SAR MARKED (OR OTHERWISE NEEDED)
KL	TDNN B,TTSAR(FLP)
KAKI	 AOJA GSCNT,GSSP2	;NO, COUNT IT AS SWEPT
KL	 AOJA A,GSSP2
KAKI	ANDCAM GSSP8,TTSAR(FLP)	;YES, TURN OFF MARK BIT
KL	ANDCAM C,TTSAR(FLP)
	AOBJN FLP,GSSP0		; AND TRY NEXT ONE
	JRST GCSW5
GSSP2:	HRRZM FXP,ASAR(FLP)	;CHAIN INTO FREE LIST
	HRRZI FXP,ASAR(FLP)
	AOBJN FLP,GSSP0
	JRST GCSW5
KAKI GSSP7:	TTS<CN+GC>,,
KAKI GSSP8:	TTS<GC>,,
KAKI GSCNT:	0
KAKI LPROG4==:.-1
KAKI OFFSET 0
KAKI .HKILL GSSP0 GSSP1 GSSP2 GSSP7 GSSP8 GSCNT

;;; PDLS ARE SAFE

SUBTTL	GC - MAKE SURE ENOUGH WAS RECLAIMED

GCPNT:	SKIPN GCGAGV
	 JRST GCE0
	SETZM GC99		;GC99 COUNTS ENTRIES PRINTED
	MOVNI F,NFF
GCPNT1:	HRRZ T,NFFS+NFF(F)
	SKIPN TT,SFSSIZ+NFF(F)
	 JRST GCPNT6
	SOSLE GC99
	 JRST GCPNT2
	STRT 17,[SIXBIT \↑M; !\]	;TERPRI-; EVERY THIRD ONE
	MOVEI D,3
	MOVEM D,GC99
GCPNT2:	PUSHJ P,STGPNT
	STRT 17,@GSTRT9+NFF(F)
	CAME F,XC-1			;COMMA AFTER EACH BUT LAST
	 STRT 17,[SIXBIT \, !\]
GCPNT6:	AOJL F,GCPNT1
	STRT 17,[SIXBIT \ WORDS FREE!\]

;FALLS THROUGH

;;;	PDLS ARE SAFE

SUBTTL	GC - CLEANUP AND TERMINATION

;FALLS IN

GCE0:	MOVNI F,NFF
GCE0C0:	MOVE AR2A,MFFS+NFF(F)
	TLNN AR2A,-1
	 JRST GCE0C1
	HRRZ AR1,SFSSIZ+NFF(F)
	FSC AR1,233		;FIXNUM TO FLONUM CONVERSION
	FMPR AR1,AR2A
	MULI AR1,400		;FLONUM TO FIXNUM CONVERSION
	ASH AR2A,-243(AR1)
GCE0C1:	SKIPGE FFS+NFF(F)
	 JRST GCE0C5
	CAIGE AR2A,MINCEL
	 MOVEI AR2A,MINCEL	;MUST SATISFY ABSOLUTE MIN OF<MINCEL> CELLS
GCE0C5:	MOVEM AR2A,ZFFS+NFF(F)
	HRRZ TT,NFFS+NFF(F)
	CAIGE TT,(AR2A)		;ALSO MUST SATISFY USER'S MIN
	 PUSHJ P,GCWORRY		;IF NOT, MUST WORRY ABOUT IT
GCE0C2:	AOJL F,GCE0C0
	MOVEI AR2A,1
	SKIPN FFY2
	 PUSHJ P,GRABWORRY	;REMEMBER, F IS ZERO HERE
	SKIPN FFY2
	 JRST GCLUZ
	MOVNI F,NFF		;IF WE RECLAIMED LESS THAN ABSOLUTE
GCE0C3:	HRRZ TT,NFFS+NFF(F)	; MINIMUM FOR ANY SPACE,
	SKIPGE FFS+NFF(F)
	 JRST GCE0C9
	CAIGE TT,MINCEL		; WE ARE OFFICIALLY DEAD
	 JRST GCLUZ
GCE0C9:	AOJL F,GCE0C3
	SKIPE PANICP
	 JRST GCE0C7
	MOVNI F,NFF	;NOW SEE IF WE EXCEEDED MAXIMUM
GCE0C6:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)
	 JRST GCE0K3
	HRLZ D,GCMES+NFF(F)
	HRRI D,1004		;GC-OVERFLOW
	PUSHJ P,UINT		;NOQUIT IS ON HERE, SO INTERRUPT GETS STACKED
GCE0K3:	AOJL F,GCE0C6
GCE0C7:	MOVNI F,NFF
GCE0C4:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)	;IF A SPACE LOST TO GC-OVERFLOW,
	 JRST GCE0K2		; DON'T MAKE IT LOSE FOR GC-LOSSAGE TOO
	MOVEM TT,XFFS+NFF(F)	;JUST QUIETLY UPDATE ITS GCMAX
	JRST GCE0K1

GCE0K2:	HRRZ T,NFFS+NFF(F)
	CAMGE T,ZFFS+NFF(F)
	 JRST GCLUZ
GCE0K1:	AOJL F,GCE0C4
IFN PAGING,[
	HRRZ TT,NOQUIT
	IOR TT,INHIBIT
	IOR TT,VNORET
	SKIPN TT
	PUSHJ P,RETSP
]		;END OF IFN PAGING
	SKIPE GCGAGV
	 STRT 17,STRTCR
;FALLS THROUGH

;;; PDLS ARE SAFE

;FALLS IN

	SKIPN VGCDAEMON
	 JRST GCEND
	MOVEI C,NIL		;CONS UP ARG FOR GCDAEMON
	MOVEI D,NFF-1		;WE CHECKED LENGTH OF FREELISTS SO
	SETZ C,			; WE KNOW CONSES WON'T RE-INVOKE GC
GCE0E:	MOVE TT,SFSSIZ(D)	;SIZE OF SPACE AFTER GC
	PUSHJ P,CONS1FX
	MOVE TT,OFSSIZ(D)	;SIZE OF SPACE BEFORE GC
	PUSHJ P,CONSFX
	HRRZ TT,NFFS(D)		;LENGTH OF FREELIST AFTER GC
	CAIN D,FFX-FFS		;ALLOW FOR THE SPACE USED
	 SUBI TT,4*NFF		; TO CONS UP THE GC-DAEMON ARG
	CAIN D,FFS-FFS
	 SUBI TT,6*NFF
	PUSHJ P,CONSFX
	HLRZ TT,NFFS(D)		;LENGTH OF FREELIST BEFORE GC
	PUSHJ P,CONSFX
	HRRZ A,GCMES(D)		;NAME OF SPACE
	PUSHJ P,CONS
	MOVE B,C
	PUSHJ P,CONS
	MOVE C,A
	SOJGE D,GCE0E
	JSR GCRSR		.SEE GCRSR0
	HRLI A,1003		;GC-DAEMON
	PUSH P,A		;FOR INTERRUPT PROTECTION ONLY
	PUSH FXP,D
	MOVS D,A
	PUSHJ P,UINT
	POPI P,1		;FLUSH SLOT "FOR INTERRUPT PRO ONLY"
	MOVE D,(FXP)
	MOVEM F,(FXP)		;USE AC F BELOW, SINCE GCLUZ REQUIRES IT
	MOVNI F,NFF		;IF THE RUNNING OF THE GC-DAEMON ATE UP ALL 
	SKIPN FFS+NFF(F)	; OUR SPACE, THEN LOSE BADLY!
	 JRST GCLUZ0
	AOJL F,.-2
	POP FXP,F
	JRST POPAJ		;REMEMBER! GCRSR HAS STACKED A SAVED "A"


;;; GC MUST EITHER JRST TO GCEND, OR JSR TO GCRSR BEFORE EXITING.
;;; THIS ASSURES THAT GCTIM WILL PROPERLY REFLECT TIME SPENT IN GC.
;;; THE VALUE IN GCTIM IS IN "HOST MACHINE UNITS".
;;; THESE ARE CONVERTED BEFORE BEING RETURNED TO THE USER.
.SEE SGCTIM

GCEND:
IFN D20,[
	MOVEI 1,.FHSLF
	RUNTM			;UPDATE GCTIM FOR D20
IFN WHL,	MOVEM 1,GC98
	SUB 1,GCTM1
	ADDM 1,GCTIM
]		;END OF IFN D20
	MOVE P,GCNASV+14-<NACS+1>
	MOVE SP,GCNASV+17-<NACS+1>
	PUSHJ P,UNBIND
	JSP NACS+1,GCACR
	SETZM GCFXP
IFE D20,[
IT$	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM	;UPDATE GCTIME FOR (STATUS GCTIME)
]	;END OF IFE D20
IFN WHL,[
	SKIPE NACS+1,GCWHO
	PUSHJ P,GCWHR
]		;END OF IFN WHL
	MOVE NACS+1,GCNASV
	HRRZS NOQUIT
	JRST CHECKI

;GCRSR:	0
GCRSR0:	HRLM C,NOQUIT		;RESTORE ACS, AND CHECK FOR ANY STACKED INTERRUPTS
IFN D20,[
	MOVEI 1,.FHSLF
	RUNTM			;UPDATE GCTIM FOR D20
IFN WHL,	MOVEM 1,GC98
	SUB 1,GCTM1
	ADDM 1,GCTIM
]		;END OF IFN D20
	MOVE P,GCNASV+14-<NACS+1>
	MOVE SP,GCNASV+17-<NACS+1>
	PUSHJ P,UNBIND
	JSP NACS+1,GCACR	;RESTORE AC'S
	SETZM GCFXP
IT$	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL*<ITS+D10>,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM	;UPDATE GCTIME FOR (STATUS GCTIME)
IFN WHL,[
	SKIPE NACS+1,GCWHO
	PUSHJ P,GCWHR
]		;END OF IFN WHL
	MOVE NACS+1,GCNASV
	PUSH P,A
	HLRZ A,NOQUIT
	PUSH P,GCRSR
	HRRZS NOQUIT
	JRST CHECKI

;;; ROUTINE TO INIT MARK BITS FOR LIST, FIXNUM, FLONUM, HUNK,
;;; AND BIGNUM SPACES. INIT BITS IN TT, RETURN ADDRESS IN F.

GCINBT:	MOVEM TT,BBITSG
	MOVE AR2A,[BBITSG,,BBITSG+1]
	BLT AR2A,@MAINBITBLT	;BLT OUT MAIN BIT AREA
	MOVE A,BTSGLK		;INITIALIZE ALL BIT BLOCKS
GCINB0:	JUMPE A,(F)
	MOVEI AR2A,(A)
	LSH AR2A,SEGLOG		;GET ADDRESS OF SEGMENT
	HRLI AR2A,(AR2A)
	MOVEM TT,(AR2A)
	AOJ AR2A,
	MOVE T,GCST(A)		;GET END ADDRESS FOR BLT
	LSH T,SEGLOG-5
	TLZ T,-1
	CAIE T,(AR2A)
	 BLT AR2A,-1(T)		;***BLT!***
	LDB A,[SEGBYT,,GCST(A)]
	JRST GCINB0

IFN WHL,[
GCWHR:	TRNN NACS+1,2		;SKIP IF GC STATISTICS DESIRED
	 JRST GCWHR2
	MOVE NACS+2,GCTIM
	IDIVI NACS+2,25000./4	;GC TIME IN FORTIETHS OF A SECOND
	MOVEM NACS+2,GCWHO2
	MOVE NACS+2,GCTIM	;GC TIME
	IMULI NACS+2,100.	; TIMES 100.
	IDIV NACS+2,GC98	; DIVIDED BY TOTAL RUNTIME
	HRLM NACS+2,GCWHO2	; EQUALS GC TIME PERCENTAGE
	TRNE NACS+1,1
	 JRST GCWHR2
	.SUSET [.SWHO2,,GCWHO2]	;JUST SET .WHO2 IF WHO VARS NOT PREVIOUSLY SAVED
GCWHR8:	MOVE NACS+2,GCNASV+1	;RESTORE ACS
	MOVE NACS+3,GCNASV+2
	POPJ P,

GCWHR2:	MOVE NACS+2,[-3,,GCWHR9]	;RESTORE WHO VARS, POSSIBLY WITH
	.SUSET NACS+2			; GC STATISTICS CLOBBERED INTO GCWHO2
	JRST GCWHR8

GCWHR9:	.SWHO1,,GCWHO1
	.SWHO2,,GCWHO2
	.SWHO3,,GCWHO3
]		;IFN WHL

SUBTTL	MISCELLANEOUS GC UTILITY ROUTINES

GCACRS:	MOVE SP,GCNASV+17-<NACS+1>	;RESTORE SP ALSO
GCACR:	SKIPN GCFXP
	 MOVEM FXP,GCFXP
	MOVE NIL,[GCACSAV+1,,1]	;RESTORE ALL ACS EXCEPT NACS+1
	BLT NIL,NACS
	MOVE NIL,[GCNASV+1,,NACS+2]
	BLT NIL,FXP
	MOVE NIL,GCACSAV
	SETZM GCFXP		.SEE CHNINT	;ETC.
	JRST (NACS+1)


$GCMKAR:	MOVE D,ASAR(A)
GCMKAR:	MOVE F,TTSAR(A)
	SKIPL D,-1(D)	;MARK FROM ARRAY ENTRIES.
	JRST (TT)
GCMKA1:	HLRZ A,(D)
	JSP T,GCMARK
	HRRZ A,(D)
	JSP T,GCMARK
	AOBJN D,GCMKA1
	JUMPE F,(TT)
	TLNE F,TTS<TY>
	TLNE F,TTS<IO>
	JRST (TT)
	MOVEI D,FB.BUF(F)	;FOR TTY INPUT FILE ARRAYS,
	HRLI D,-NASCII/2	; MUST MARK INTERRUPT FUNCTIONS
	SETZ F,
	JRST GCMKA1

;;; GCGEN GENERATES NON-NULL BUCKETS OF THE CURRENT OBARRAY
;;; AND APPLIES A GIVEN FUNCTION TO THEM. IT IS CALLED AS
;;;		JSP R,GCGEN
;;;		   FOO
;;; GCGEN WILL EFFECTIVELY DO A  JRST FOO  MANY TIMES,
;;; PASSING SOME NON-NULL OBARRAY BUCKET THROUGH ACCUMULATOR D.
;;; FOO IS EXPECTED TO RETURN BY DOING A  JRST GCP8A.
;;; WHEN DONE, GCGEN RETURNS, SKIPPING OVER THE ADDRESS FOO.

GCGEN:	MOVE F,@VOBARRAY	.SEE ASAR
	MOVE F,-1(F)
	SUB F,R70+1
	TLZ R,400000
GCP8A:	TLCE R,400000
	JRST GCP8A1
	AOBJP F,1(R)	;EXIT
	HLRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A
GCP8A1:	HRRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A


;;; MARK AN S-EXPRESSION GIVEN IN A. TRACES IT COMPLETELY,
;;; MARKING ALL SUBITEMS BY SETTING A MARK BIT TO **ZERO**
;;; FOR LIST, FIXNUM, FLONUM, AND BIGNUM SPACES, AND TO
;;; **ONE** FOR SYMBOLS AND SARS. (THIS SPEEDS UP SWEEPING.)
;;; NEVER MARKS VALUE CELLS!!!! (THEY ARE NEVER SWEPT.)
;;; CALLED BY JSP T,GCMARK WITH OBJECT IN A. USES A,B,C,AR1,AR2A.

GCMARK:	JUMPE A,(T)		;NEEDN'T MARK NIL
	MOVEI AR2A,(P)		;REMEMBER WHERE P IS
GCMRK0:	JRST GCMRK1	.SEE KLINIT

GCMRK3:	TLNN A,GCBSYM		;MAYBE WE FOUND A SYMBOL
	 JRST GCMRK4		;NOPE
	HLRZ AR1,(C)		;YUP
	TROE AR1,1
	 JRST GCMKND
	HRLM AR1,(C)
	PUSH P,(C)		;PUSH PROPERTY LIST
	PUSH P,(AR1)		;PUSH PNAME LIST
	SKIPE ETVCFLSP		;A HAC TO SAVE TIME IF THERE NEVER HAVE BEEN
	 JRST GCMRK6		; VALUE CELLS TAKEN FROM LIST SPACE
	HRRZ A,@-1(AR1)
	JRST GCMRK1		;GO MARK VALUE OF SYMBOL

GCMRK6:	HRRZ A,-1(AR1)
	CAIGE A,EVCSG
	 CAIGE A,BVCSG
	  JRST GCMRK7
	HRRZ A,(A)
	CAIE A,QUNBOUND
	 JRST GCMRK1
	JRST GCMRK8

GCMRK7:	LSH A,-SEGLOG
	SKIPL A,GCST(A)		;SKIP IF VALUE CELL NOT A LIST CELL??
	 JRST GCMKND		;SUNBOUND, FOR EXAMPLE????
	HRRZ A,-1(AR1)		;POINTING TO A VC IN LIST SPACE
	JRST GCMRK1

GCMRK4:	TLNN A,GCBVC		;MAYBE WE FOUND A VALUE CELL
	 JRST GCMRK5		;NOPE
	HRRZ A,(C)		;YUP - MARK ITS CDR (THE VALUE)
	JRST GCMRK1

GCMRK5:	MOVSI AR1,TTS<GC>	;MUST BE AN ARRAY
	IORM AR1,TTSAR(C)	;SET ARRAY MARK BIT TO 1
GCMKND:	CAIN AR2A,(P)		;SKIP IF ANYTHING LEFT ON STACK TO MARK
	 JRST (T)		;ELSE RETURN
GCMRK8:	POP P,A			;GET NEXT ITEM TO MARK
GCMRK1:	HRRZS C,A		;ZERO LEFT HALF OF A, ALSO SAVE IN C
	SETZ B,
	LSHC A,-SEGLOG		;GET PAGE NUMBER OF ITEM (OTHER BITS GO INTO B)
	SKIPL A,GCST(A)		;CHECK GCST ENTRY FOR THAT PAGE
	 JRST GCMKND		;NOT MARKABLE - IGNORE IT
	TLNE A,GCBFOO		;MAYBE IT'S A VALUE CELL OR SYMBOL OR SAR
	 JRST GCMRK3		;IF SO HANDLE IT SPECIALLY
	LSHC A,SEGLOG-5		;THIS GETS ADDRESS OF BIT WORD FOR THIS ITEM
	ROT B,5			;B TELLS US WHICH BIT (40/WD)
	MOVE AR1,(A)		;GET WORD OF MARK BITS
	TDZN AR1,GCBT(B)	;CLEAR THE ONE PARTICULAR BIT
	 JRST GCMKND		;QUIT IF ITEM ALREADY MARKED
	MOVEM AR1,(A)		;ELSE SAVE BACK WORD OF BITS
	JUMPGE A,GCMKND	.SEE GCBCDR	;JUMP UNLESS MUST MARK THROUGH (REMEMBER THE LSHC)
	HRR A,(C)		;GET CDR OF ITEM
	TLNN A,GCBCAR←<SEGLOG-5> ;MAYBE WE ALSO WANT TO MARK THE CAR
	 JRST GCMRK1		;NO - GO MARK CDR
	PUSH P,A		;YES - SAVE CDR ON STACK
	HLR A,(C)		;GET CAR OF ITEM AND GO MARK IT
IFE HNKLOG, 	JRST GCMRK1
IFN HNKLOG,[
	TLNN A,GCBHNK←<SEGLOG-5>
	 JRST GCMRK1		;ORDINARY LIST CELL
	PUSH P,T		;FOR HUNK, SAVE T AND AR2A SO
	HRLM AR2A,(P)		; CAN CALL GCMARK RECURSIVELY
	MOVEI A,(C)
	LSH A,-SEGLOG
	HRRZ A,ST(A)		;GET TYPEP OF HUNK
   2DIF [HRL C,(A)]GCHNLN,QHUNK0	;C NOW HAS AOBJN POINTER
	MOVEI AR2A,(P)		;SET UP AR2A FOR RECURSIVE GCMARK
GCMRK2:	MOVEM C,-1(P)		;SAVE AOBJN POINTER IN SLOT PUSHED FOR CDR
	HLRZ A,(C)
	JUMPE A,GCMK2A
	JSP T,GCMRK1		;MARK ODD HUNK SLOT
	MOVE C,-1(P)
GCMK2A:	HRRZ A,(C)
	JUMPE A,GCMK2B
	JSP T,GCMRK1		;MARK EVEN HUNK SLOT
	MOVE C,-1(P)
GCMK2B:	AOBJN C,GCMRK2
	POP P,T			;RESTORE T AND AR2A
	HLRZ AR2A,T
	SUB P,R70+1		;FLUSH AOBJN POINTER
	JRST GCMKND

GCHNLN:	-1
	REPEAT HNKLOG, -<2←.RPCNT>	;LH'S FOR AOBJN POINTERS
]		;END OF IFN HNKLOG

COMMENT |	ONE OF THESE DAYS I'LL DEBUG THE MICROCODE FOR THIS - GLS

IFN ITS,[ IFE SEGLOG-11,[ IFLE HNKLOG-5,[
;;; MARK ROUTINE FOR USE WITH KL-10 MICROCODE

LSPGCM=:070000,,
LSPGCS=:071000,,

KLGCVC:	SKIPA A,(A)
	 PUSH P,B
KLGCM1:	LSPGCM A,KLGCM2
KLGCND:	CAIN AR2A,(P)
	 JRST (T)
	POP P,A
	JRST KLGCM1

KLGCM2:	JRST KLGCSY
	JRST KLGCVC
	JRST KLGCSA
REPEAT HNKLOG, JRST CONC KLGH,\.RPCNT+1
REPEAT 8-.+KLGCM2, .VALUE

KLGCSY:	HLRZ AR1,(A)
	TROE AR1,1
	 JRST KLGCND
	HRLM AR1,(A)
	PUSH P,(A)
	PUSH P,(AR1)
	HRRZ A,@-1(AR1)
	JRST KLGCM1

KLGCSA:	MOVSI AR1,TTS<GC>
	IORM AR1,TTSAR(A)
	JRST KLGCND

IFN HNKLOG,[
ZZZ==<1←HNKLOG>-1
REPEAT HNKLOG,[
CONC KLGH,\HNKLOG-.RPCNT,:
REPEAT 1←<HNKLOG-.RPCNT-1>,[
	PUSH P,ZZZ(A)
	HLRZ B,(P)
	PUSH P,B
ZZZ==ZZZ-1
]		;END OF REPEAT 1←<HNKLOG-.RPCNT-1>
]		;END OF REPEAT HNKLOG
IFN ZZZ, WARN [YOU LOSE]
	PUSH P,(A)
	HLRZ A,(A)
	JRST KLGCM1
]		;END OF IFN HNKLOG


KLGCSW:	MOVNI T,3+BIGNUM		;SWEEP
KLGS1:	SETZB C,AR1			;ZERO FREELIST AND COUNT
	SKIPN TT,FSSGLK+3+BIGNUM(T)
	 JRST KLGS1D
KLGS1A:	MOVE B,GCST(TT)
	LSH B,SEGLOG-5
	TLZ B,-1
	MOVEI A,(TT)
	LSH A,SEGLOG
	HRLI A,-SEGSIZ
	LSPGCS A,1
	LDB TT,[SEGBYT,,GCST(TT)]
	JUMPN TT,KLGS1A
KLGS1D:	MOVEM C,FFS+3+BIGNUM(T)
	HRRM AR1,NFFS+3+BIGNUM(T)
	AOJL T,KLGS1
	JRST GCSW4A

]]]		;END OF IFLE HNKLOG-5, IFE SEGLOG-11, IFN ITS

|		;END OF COMMENT

GSGEN:	SKIPN AR2A,GCMKL	;GENERATE TAILS OF GCMKL AND APPLY 
	POPJ P,			;FUN IN AR1 TO THEM
	PUSH P,AR1
	MOVEI AR1,GCMKL
	JRST GGEN1

RTSPC2:	JUMPE A,GGEN2
RTSP2A:	ADD D,TT
GGEN2:	HRRZ AR2A,(AR2A)	;GENERAL LOOP FOR GSGEN
	MOVEI AR1,(AR2A)
	HRRZ AR2A,(AR2A)
GGEN1:	JUMPE AR2A,POP1J	;TAIL OF GCMKL IN AR2A,
	HRRZ A,(AR2A)		;SPACE OCCUPIED IN TT,
	HLRZ A,(A)		;ALIVEP IN A
	MOVE TT,(A)
	HLRZ A,(AR2A)
	HLRZ A,ASAR(A)
	JRST @(P)	;ROUTINE WILL RETURN TO GGEN2


GFSPC:	PUSH FXP,AR1
	PUSHJ P,CNLAC	;COUNT NUMBER OF LIVING ARRAY CELLS
	POP FXP,AR1
	ADD D,@VBPORG	;NOW HAS TOTAL AMOUNT FREE IN BPS [COUNTING DEAD BLOCKS]
	ADD D,GAMNT	;NOW DIMINISHED BY REQUESTED AMOUNT
	CAMG D,BPSH
	JRST GRELAR	;IF ENOUGH SPACE, THEN RELOCATE
	JRST (R)

IFN PAGING,[
GTSP5A:	SETZB A,TT		;GIVE OUT NIL AND 0 IF FAIL
	JUMPLE AR1,CZECHI
	PUSHJ P,BPSGC
	JSP R,GFSPC
	SETZ AR1,
	JRST GTSP1B
]		;END OF IFN PAGING

BPSGC:	PUSH FXP,NOQUIT		;SAVE CURRENT STATE OF FLAG
	HLLZS NOQUIT		;FORCE OFF RIGHT HALFWORD
	PUSH P,[444444,,BPSGX]	;MAGIC NUMBER,,RETURN ADR
	JRST AGC
BPSGX:	POP FXP,NOQUIT		;RESTORE OLD SETTING OF FLAGS
	POPJ P,

;;; SOME ROUTINES FOR USE WITH GSGEN

GCP8K:	HLRZ A,(D)
	JSP T,GCMARK
GCP8J:	HRRZ D,(D)	;MARK ATOMS ON OBLIST
GCP8I:	JUMPE D,GCP8A	;WHICH HAVE NON-TRIVIAL
	MOVE A,D	;P-LIST STRUCTURE.
	JSP T,TWAP
	JRST GCP8J
	JRST GCP8K
	JRST GCP8J

GCP8G:	JUMPE D,GCP8A	;REMOVE T.W.A.'S FROM
	MOVE A,D	;BUCKETS OF OBLIST.
	JSP T,TWAP
	JRST GCP8B
	JRST GCP8B
	HRRZ D,(D)
	TLNE R,400000	;BUCKET COMES FROM LH OF WORD IN OBARRAY
	HRLM D,(F)	;IF AT THIS POINT R < 0
	TLNN R,400000
	HRRM D,(F)
	JSP T,GCP8L
	JRST GCP8G
GCP8C:	HRRZ D,(D)
GCP8B:	HRRZ A,(D)
GCP8D:	JUMPE A,GCP8A
	JSP T,TWAP
	JRST GCP8C
	JRST GCP8C
	HRRZ A,(D)
	HRRZ A,(A)
	HRRM A,(D)
	JSP T,GCP8L
	JRST GCP8B

GCP8H:	MOVE A,D	;MARK OBLIST BUCKET
	JSP T,GCMARK
	JRST GCP8A

GCP8L:	JUMPE TT,(T)	;IF SCO REMOB'D, THEN REMOVE FROM SCO TABLE
	HRRZ A,(TT)
	JUMPN A,(T)
	HLRZ A,(TT)
	MOVE B,(A)	;MUST NOT BE INTERRUPTIBLE HERE
	MOVEI A,0
	LSHC A,7
	JUMPN B,(T)
	HRRZ TT,VOBARRAY
	HRRZ TT,TTSAR(TT)
	ADDI TT,<OBTSIZ+1>/2
	ROT A,-1
	ADD TT,A
	JUMPL TT,GCP8L5
	HRRZS (TT)
	JRST (T)
GCP8L5:	HLLZS (TT)
	JRST (T)

TWAP:	HLRZ A,(A)
	JUMPE A,(T)		;NIL IS ALREADY MARKED
	HLRZ TT,(A)
	TRZE TT,1
	 JRST (T)		;NO SKIP IF ALREADY MARKED
	MOVE B,SYMVC(TT)
	MOVE TT,SYMARGS(TT)
	TLNN B,SY.CCN\SY.PUR	;SKIP 1 IF SYMBOL HAS SOME NON-TRIVIAL
	 TLZE TT,-1		;PROPERTIES:  ARGS OR COMPILED CODE REFERENCE
	  JRST 1(T)
	HRRZ B,(B)
	HRRZ A,(A)
	CAIN B,QUNBOUND
	 JUMPE A,2(T)		;SKIP 2 IF TRULY WORTHLESS SYMBOL,
				; I.E., UNBOUND AND NO PROPERITES
	JRST 1(T)		;SKIP 1 IF MEANINGFUL PROPERTIES OR VALUE

;;; PRINT MESSAGE OF FORM "NNN[MM%] " FOR GC STATISTICS OUTPUT

STGPNT:	PUSH FXP,F		;NEED TO SAVE F (IN CASE OF IFORCE)
	PUSH FXP,T		;RECLAIMED AMNT IN T, TOTAL FOR SPACE IN TT
	IMULI T,100.
	IDIVM T,TT
	EXCH TT,(FXP)
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	MOVEI R,$TYO
IFE USELESS,	MOVE C,@VBASE	;BASE HAD DAMNED WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN		;SKIPS
]		;END OF IFN USELESS
	   PUSHJ P,PRINI2
	STRT 17,[SIXBIT \[!\]	;BEWARE THESE BRACKETS!!!!!
	POP FXP,TT
IFE USELESS,	MOVEI C,10.
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,[10.]
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI3	;EFFECTIVELY, PRINI2 WITH *NOPOINT=T
	STRT 17,[SIXBIT \%] !\]	;BEWARE THESE BRACKETS!!!!!
	POP FXP,F
	POPJ P,


;;; VERY IMPORTANT TABLE OF WORDS WITH SINGLE BITS!!! USED FOR MARKING!!!
GCBT:	REPEAT 36., SETZ←-.RPCNT

IFN PAGING,[

SUBTTL	RETURN CORE TO TIMESHARING SYSTEM

;;; HAIRY ROUTINE TO DECIDE WHETHER TO RETURN SOME BPS TO THE SYSTEM.
;;; MAY ONLY BE CALLED WHEN NOQUIT SPECIFIES NO INTERRUPTS.

RETSP:
10$	POPJ P,			;NOOP ON D10'S RUNNING PAGING LISP
IFE D10,[
	MOVEI TT,4		;GTSPC1 IS ALLOWED TO GRAB 4 PAGES
	MOVEM TT,ARPGCT		; BEFORE INVOKING GC FOR LACK OF CORE
	PUSHJ P,CNLAC		;COUNT NUMBER OF LIVING ARRAY CELLS
	MOVE TT,BPSH
	LSH TT,-PAGLOG		;CURRENT HIGHEST CORE BLOCK IN BPS
	MOVE R,@VBPORG
	ADDI R,1(D)
	LSH R,-PAGLOG		;CORE NEEDED IF ARRAYS WERE PACKED
	CAML R,TT
	POPJ P,
	LSH R,PAGLOG
	ADDI R,PAGSIZ-1
	HRLM R,RTSP1		;NEW BPSH
	SUB R,D
	HRRM R,RTSP3		;NEW BPEND
	JUMPE D,RTSP5
	HRLM D,RTSP3		;NUMBER OF CELLS TO MOVE
	PUSHJ P,GRELAR		;GRELAR LEAVES BPEND-AFTER-RELOCATION IN TT
	HRL AR1,TT
	HRR AR1,RTSP3		;BLOCK PTR
	SUBI TT,(AR1)
	JUMPLE TT,RTSP2
	MOVNI TT,1(TT)
	HRRM TT,RTSP1
	ADD AR1,R70+1
	HLRZ C,RTSP3
	ADD C,RTSP3
	BLT AR1,(C)
	MOVEI AR1,RTSPC1
	PUSHJ P,GSGEN		;DO PATCH-UP ON ARRAY PARAMETERS
	JSP T,RSXST		;????
RTSP2:	HLRZ TT,RTSP1
	MOVE R,TT
	EXCH R,BPSH
	HRRZ D,RTSP3
	MOVEM D,@VBPEND
	LSH R,-PAGLOG		;OLD CORE HIGHEST
	LSH TT,-PAGLOG		;NEW CORE HIGHEST
	MOVEI F,1(TT)		;MAKE UP A POINTER INTO THE PURTBL
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
IT$	SUBM TT,R		;FOR ITS, MINUS THE NUMBER OF PAGES TO HACK
20$	SUBI R,(TT)		;FOR D20, THE POSITIVE NUMBER OF PAGES TO HACK
	AOS D,TT
IFN ITS,[
	HRLI TT,(R)		;-<NUMBER OF PAGES>,,<INITIAL PAGE NUMBER>
	.CALL RTSP9		;FLUSH THE PAGES
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	SETO 1,			;-1 MEANS DELETE PAGES
	MOVSI 2,.FHSLF		;FROM SELF
	HRRI 2,(TT)		;INITIAL PAGE NUMBER
	MOVEI 3,(R)		;NUMBER OF PAGES
	TLO 3,PM%CNT		;SET ITERATION BIT
	PMAP
]		;END OF IFN D20
	LSH D,-SEGLOG+PAGLOG
	MOVE T,[$NXM,,QRANDOM]	;STANDARD ST ENTRY FOR A FLUSHED PAGE
RTSP7:	TLNN F,730000
	 TLZ F,770000
	IDPB NIL,F		;UPDATE PURTBL ENTRY FOR ONE PAGE
REPEAT SGS%PG,	MOVEM T,ST+.RPCNT(D)	;UPDATE ST ENTRIES
	ADDI D,SGS%PG
IT$	AOJL R,RTSP7
20$	SOJG R,RTSP7
	POPJ P,

IFN ITS,[
RTSP9:	SETZ
	SIXBIT \CORBLK\		;HACK PAGE MAP
	  1000,,0		;DELETE PAGES
	  1000,,%JSELF		;FROM CURRENT JOB
	400000,,TT		;AOBJN POINTER: -<COUNT>,,<PAGE NUMBER>
]		;END OF IFN ITS

RTSP5:	SETZM GCMKL	;NO ARRAYS ALIVE
	MOVE TT,R
	PUSHJ P,BPNDST	;SETQ UP BPEND
	JRST RTSP2

RTSPC1:	JUMPE A,GGEN2
	HRRE B,RTSP1	;-<SIZE OF SHIFT + 1>
	JSP AR1,GT3D
	JRST GGEN2

]	;END IFE D10
]		;END OF IFN PAGING

SUBTTL	GET SPACE FROM TIMESHARING SYSTEM

GTSPC1:	HLLOS NOQUIT
	JSP R,GFSPC		;SEE IF FREE SPACE ABOVE BPEND WILL ADD ENOUGH
IFN PAGING,[
	SKIPLE AR1,ARPGCT
	 JRST GTSP1B
]		;END OF IFN PAGING
	PUSHJ P,BPSGC		;WHEN COMPACTIFIED AND RELOCATED
	JSP R,GFSPC		;IF NOT, GC AND TRY AGAIN
GTSP1B:
IFE PAGING,[
	SETZB A,TT		;GIVE OUT NIL AND 0 IF WE FAIL
	JRST CZECHI
]		;END OF IFE PAGING
IFN PAGING,[
	CAML D,HINXM
	 JRST GTSP5A
	MOVEI T,(D)
	TRO T,PAGSIZ-1
	MOVE R,BPSH
	LSH D,-PAGLOG
	LSH R,-PAGLOG
	SUBM R,D		;NEGATIVE OF NUMBER OF PAGES TO GET
	ADDM F,ARPGCT
	MOVEI F,1(R)		;SET UP BYTE POINTER INTO PURTBL
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
	MOVEI TT,1(R)
	LSH TT,-SEGLOG+PAGLOG
	HLRZ AR1,(P)		;BEWARE! LH OF CALLING PDL SLOT = -1
	TRNN AR1,1		; MEANS THE GETSP FUNCTION IS CALLING
	 TROA AR1,3
	  MOVEI AR1,1
IFN ITS,[
	HRLI R,(D)
	HRRI R,1(R)
	.CALL GTSPC8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	PUSH P,D		;SAVE NEGATIVE COUNT
	PUSH P,R		;AND SAVE CURRENT PAGE NUMBER
GTSPC8:	AOS R,(P)		;GET NEXT PAGE NUMBER
	LSH R,PAGLOG		;TURN INTO POINTER TO PAGE
	SETMM (R)		;CREATE THE PAGE
	MOVSI 1,.FHSLF		;OUR PROCESS
	HRR 1,(P)		;CURRENT PAGE NUMBER
	MOVSI 2,(PA%RD\PA%WT\PA%EX) ;READ, WRITE, EXECUTE
	SPACS			;SET THEPAGE ACCESS
	AOJL D,GTSPC8
	POP P,R
	POP P,D
]		;END OF IFN D20
	MOVE A,[$XM,,QRANDOM]
GTSPC2:	TLNN F,730000
	 TLZ F,770000
	IDPB AR1,F		;UPDATE PURTBL ENTRY
REPEAT SGS%PG,	MOVEM A,ST+.RPCNT(TT)	;UPDATE ST ENTRIES
	ADDI TT,SGS%PG
	AOJL D,GTSPC2
	MOVEM T,BPSH		;FALLS INTO GRELAR
]		;END OF IFN PAGING
GRELAR:	HLLOS NOQUIT	;MOBY DELAYED QUIT FEATURE.
	HRRZ A,BPSH	;LEAVE BPEND-AFTER-RELOCATION AS RESULT
	MOVEM A,GSBPN	;TEMPORARY BPEND
	MOVEI AR1,GTSPC3
	PUSHJ P,GSGEN	;RELOCATE ARRAYS
	JSP T,RSXST
GREL1:	MOVE TT,GSBPN
	PUSHJ P,BPNDST
	MOVE TT,(A)
CZECHI:	HLLZS NOQUIT
	JRST CHECKI	;CHECK FOR ↑G THEN POPJ P,

IFN ITS,[
GTSPC8:	SETZ
	SIXBIT \CORBLK\		;HACK PAGE MAP
	  1000,,%CBNDR+%CBNDW	;NEED READ AND WRITE ACCESS
	  1000,,%JSELF		;FOR MYSELF
	      ,,R		;AOBJN POINTER: -<COUNT>,,<PAGE NUMBER>
	401000,,%JSNEW		;WANT FRESH PAGES
]		;END OF IFN ITS

SUBTTL	ARRAY RELOCATOR

CNLAC:	MOVEI D,0		;COUNT NUMBER OF LIVING ARRAY CELLS, IN D
	MOVEI AR1,RTSPC2
	JRST GSGEN

BPNDST:	JSP T,FIX1A		;STORE NEW VALUE FOR BPEND
	MOVEM A,VBPEND
	POPJ P,

;;; COMES HERE FROM GRELAR VIA GSGEN.  AR2A HAS TAIL OF GCMKL, TT HAS TOTAL LENGTH OF ARRAY
GTSPC3:	JUMPE A,GT3G		;RELOCATE AN ARRAY
	MOVEI AR1,-1(TT)	;LENGTH-1 OF ARRAY IN AR1
	HLRZ F,(AR2A)
	HRRZ A,ASAR(F)
	SUBI A,1		;ARRAY AOBJN PTR LOC IN A.
	MOVE C,GSBPN
	SUBI C,(AR1)
	MOVEM C,GSBPN		;LOC NEW BPTR IN C
	MOVEI B,(C)
	SUBI B,1(A)		;RELOCATION AMOUNT-1 IN B
	CAML A,C		;IS ARRAY ALREADY IN PLACE?
	 JRST GT3C		;YES, SO EXIT
IFN D10,[
	MOVE R,ASAR(F)
	MOVE F,TTSAR(F)
	TLNN R,AS.FIL		;IF THE ARRAY IS A FILE OBJECT,
	 JRST GT3H		; IS NOT CLOSED, AND HAS BUFFERS,
	TLNN F,TTS.CL		; THEN WE MUST LET THE I/O COMPLETE
	 SKIPGE F.MODE(F)	.SEE FBT.CM
	  JRST GT3H
IFE SAIL,[
	TLNN F,TTS.IO		;OUTPUT?
	 JRST GT3Z		;NOPE, JUST WAIT
	MOVE T,F.CHAN(F)	;GET CHANNEL NUMBER
	LSH T,27
	TLO T,(OUTPUT)		;FLUSH ALL OUTPUT BUFFERS
	XCT T
]	;END IFE SAIL
GT3Z:	MOVE F,F.CHAN(F)
	LSH F,27
	IOR F,[WAIT 0,]		;WAIT FOR THE I/O TO SETTLE DOWN
	XCT F			; SO WE CAN RELOCATE THE BUFFERS
GT3H:
]		;END OF IFN D10
	SUBI C,(AR1)
	CAMGE A,C		;BEWARE: C COULD GO NEGATIVE!
	 JRST GT3A		;GOOD, EASY BLT
	ADDI C,(AR1)
	ADDI AR1,1(A)		;FIRST DESTINATION LOC
GT3B:	HRRZI C,(AR1)
	SUBI AR1,1(B)		;CONSTRUCT SOURCE ADDRESS
	HRLI C,(AR1)
	HRRZI T,(C)
	ADDI T,(B)
	BLT C,(T)		;SERIES OF SMALL BLTS
	CAMLE AR1,GSBPN
	 JRST GT3B
	ADDI AR1,(B)
	SUB AR1,GSBPN
	MOVE A,GSBPN
	SUBI A,1(B)
GT3A:	MOVE C,GSBPN
	ADDI AR1,(C)
	HRL C,A
	BLT C,(AR1)	;FINAL (OR ONLY) BLT
	JSP AR1,GT3D
GT3C:	SOS GSBPN
	JRST GGEN2

GT3D:	ADDI B,1
	HLRZ A,(AR2A)
	ADDM B,ASAR(A)	;UPDATE ARRAY POINTERS BY OFFSET IN B
	ADDM B,TTSAR(A)
	MOVE C,ASAR(A)
	ADDM B,-1(C)	;UPDATE AOBJN PTR BEFORE ARRAY HEADER
	HRR C,TTSAR(A)		;FOR A BUFFERED FILE OBJECT, WE MUST
	TLNE C,AS.FIL		; RELOCATE CERTAIN ADDRESSES IN THE ARRAY DATA
	 SKIPGE F.MODE(C)	.SEE FBT.CM
	  JRST (AR1)
	MOVE C,TTSAR(A)
IFN ITS+D20,[
	ADDM B,FB.IBP(C)
	ADDM B,FB.BP(C)
	JRST (AR1)
]		;END OF ITS+D20
IFN D10,[
	TLNE C,TTS.CL		;DON'T HACK WITH CLOSED FILE OBJECTS
	 JRST (AR1)
	MOVE F,FB.HED(C)
	ADDM B,(F)		;UPDATE CURRENT BUFFER ADDRESS
	ADDM B,1(F)		;UPDATE BYTE POINTER
	HRRZ F,(F)
	MOVE R,F
GT3D2:	ADDM B,(R)		;UPDATE BUFFER RING POINTERS
	HRRZ R,(R)
	CAIE R,(F)		;DONE WHEN WE HAVE GONE AROUND THE RING
	 JRST GT3D2

IFN SAIL,[
	MOVE R,F.CHAN(C)	;GET CHANNEL NUMBER
	LSH R,27
	HRR R,FB.HED(C)		;POINTER TO BUFFER HEADER
	HRR R,(R)		;GET CURRENT ADDR OF BUFFER
	TLNN C,TTS.IO		;DO APPROPRIATE UUO TO MOVE BUFFER
	 TLOA R,(INPUT)
	  TLO R,(OUTPUT)
	XCT R
	JRST (AR1)
]	;END OF IFN SAIL
IFE SAIL,[
	TLNN C,TTS.IO
	 JRST GT3D4
	MOVE R,F.CHAN(C)	;GET CHANNEL NUMBER
	LSH R,27		;FOR OUTPUT BUFFERS
	HRR R,FB.HED(C)		;GET CURRENT ADR OF BUFFER
	HRR R,(R)
	TLO R,(OUTPUT)		;DO APPROPRIATE UUO TO MOVE BUFFER
	XCT R
	JRST (AR1)

GT3D4:	MOVSI R,TTS.BM
	IORM R,TTSAR(A)
	JRST (AR1)
]	;END OF IFE SAIL

]		;END OF IFN D10

GT3G:	HRRZ AR2A,(AR2A)
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)		;CUT OUT DEAD BLOCK
	JRST GGEN1

	PGTOP GC,[GARBAGE COLLECTOR]

;;; ********** MEMORY MANAGEMENT, ETC **********

SUBTTL	PURCOPY FUNCTION

	PGBOT BIB

PURCOPY:
	PUSHJ FXP,SAV5M2
	PUSH P,[RST5M2]
	PUSH FXP,CCPOPJ
	PUSHJ P,SAVX5
	PUSH P,[RSTX5]
	MOVEI TT,(A)	;USES A,B,T,TT
	LSH TT,-SEGLOG
	MOVE TT,ST(TT)
	TLNE TT,PUR
	 POPJ P,
   2DIF JRST (TT),PCOPY9,QLIST	.SEE STDISP

PCOPY9:	JRST PCOPLS		;LIST
	JRST PCOPFX		;FIXNUM
	JRST PCOPFL		;FLONUM
DB$	JRST PCOPDB		;DOUBLE
CX$	JRST PCOPCX		;COMPLEX
DX$	JRST PCOPDX		;DUPLEX
BG$	JRST PCOPBN		;BIGNUM
	JRST PCOPSY		;SYMBOL
HN$ REPEAT HNKLOG+1, JRST PCOPHN	;HUNKS
	POPJ P,			;RANDOM
	MOVSI TT,100		;ARRAY
IFN .-PCOPY9-NTYPES, WARN [WRONG LENGTH TABLE]
	IORM TT,(A)		;SET "COMPILED CODE NEEDS ME" BIT
	POPJ P,

PCOPLS:	HLRZ B,(A)		;PURCOPY A LIST ALREADY
	PUSH P,B
	HRRZ A,(A)
	SKIPE A			;NEVER PURCOPY NIL
	 PUSHJ P,PURCOPY
	EXCH A,(P)
	SKIPE A			;NEVER PURCOPY NIL
	 PUSHJ P,PURCOPY
	POP P,B
PCONS:	AOSL TT,NPFFS		;PURE FS CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG		;NOTE: CLOBBERS TT
	ADD TT,EPFFS
   NOPRO
	HRLM A,(TT)
	HRRM B,(TT)
	MOVEI A,(TT)
	POPJ P,

PCOPFX:	MOVE TT,(A)
PFXCONS:	CAIGE TT,XHINUM	;PURE FIXNUM CONSER
	CAMGE TT,[-XLONUM]
	JRST PFXC1
	MOVEI A,IN0(TT)
	POPJ P,			;NOTE: EXITS WITH POPJ P,!!!
PFXC1:	AOSL A,NPFFX
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFX
   NOPRO
PFXC3:	MOVEM TT,(A)
	POPJ P,


PCOPFL:	MOVE TT,(A)
PFLCONS:	AOSL A,NPFFL	;PURE FLONUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFL
   NOPRO
	JRST PFXC3		;ALSO EXITS WITH POPJ P,!!!


IFN CXFLAG,[
PCOPCX:
KA	MOVE D,1(A)
KA	MOVE TT,(A)
KIKL	DMOVE TT,(A)
PCXCONS:	AOSL A,NPFFC
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,1(A)
	MOVEM T,NPFFC
	ADD A,EPFFC
   NOPRO
DB%	JRST PDBC3		;WILL DROP IN IF NO DOUBLES
]		;END OF IFN CXFLAG
IFN DBFLAG,[
PCOPDB:
KA	MOVE D,1(A)
KA	MOVE TT,(A)
KIKL	DMOVE TT,(A)
PDBCONS:	AOSL A,NPFFD
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,1(A)
	MOVEM T,NPFFD
	ADD A,EPFFD
   NOPRO
]		;END OF IFN DBFLAG
IFN DBFLAG+CXFLAG,[
PDBC3:
KA	MOVEM D,1(A)
KA	JRST PFXC3
KIKL	DMOVEM TT,(A)
KIKL	POPJ P,
]		;END OF IFN DBFLAG+CXFLAG


IFN DXFLAG,[
PCOPDX:
KA	REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT
KIKL	DMOVE R,(A)
KIKL	DMOVE TT,2(A)
PDXCONS:	AOSL A,NPFFZ
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,3(A)
	MOVEM T,NPFFZ
	ADD A,EPFFZ
   NOPRO
KA	REPEAT 4, MOVEM TT+<2#.RPCNT>,.RPCNT
KIKL	DMOVEM R,(A)
KIKL	DMOVEM TT,2(A)
	POPJ P,
]		;END OF IFN DBFLAG

IFN BIGNUM,[
PCOPBN:	PUSH P,(A)
	HRRZ A,(A)
	PUSHJ P,PURCOPY
	HLL A,(P)
	SUB P,R70+1
PBNCONS:	AOSL TT,NPFFB	;PURE BIGNUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD TT,EPFFB
   NOPRO
	MOVEM A,(TT)
	MOVEI A,(TT)
	POPJ P,
]		;END OF IFN BIGNUM

PCOPSY:	PUSH P,A		;SAVE POINTER TO SYMBOL
	HLRZ B,(A)		;FETCH POINTER TO SYMBOL BLOCK
	MOVE TT,SYMVC(B)
	TLNE TT,SY.PUR		;IF ALREADY PURE IGNORE COMPLETELY
	 JRST PCOPS1
	PUSH P,B		;SAVE SYMVC ADR
	HRRZ A,SYMPNAME(B)
	PUSHJ P,PURCOPY		;PURCOPY THE PNAME
	PUSHJ P,PSYCONS		;GET A PURE SY2 BLOCK
	POP P,B			;RESTORE SYMVC ADR
	HLRZ A,(A)		;GET POINTER TO PURE SY2
	HRRZ TT,SYMVC(B)	;GET THE VALUE CELL
	HRRM TT,SYMVC(A)	;COPY INTO NEW PURE SY2
	HLLZ TT,SYMARGS(B)	;ALSO COPY THE ARGS PROPERTY
	HLLM TT,SYMARGS(A)
XCTPRO
	HLRZ B,@(P)		;GET POINTER TO OLD SY2
	EXCH B,FFY2		;THIS IS NEW HEAD OF FREELIST, GET OLD HEAD
	MOVEM B,@FFY2		;PLACE CHAIN IN NEWLY FREED CELL
NOPRO
	HRLM A,@(P)		;STORE POINTER TO NEW SY2 BLOCK
PCOPS1:	LOCKI
	HRRZ A,(P)		;GET POINTER TO SYMBOL
	PUSHJ P,SYMHSH		;GET HASH VALUE
	IDIVI T,OBTSIZ		;MAKE POINTER INTO OBARRAY
	PUSH FXP,TT
	MOVEI A,(FXP)
	MOVE T,VOBARRAY
	PUSHJ P,@ASAR(T)	;BUCKET ADR
	MOVEI B,(A)
	HRRZ A,(P)
	PUSHJ P,MEMQ1		;FIND ACTUAL ATOM
	POP FXP,D
	JUMPN A,PCOPS3		;IF IN OBARRAY NO NEED TO GCPROTECT
	MOVEI T,1		;GCPROTECT
	HRRZ A,(P)
	PUSHJ P,.GCPRO
PCOPS3:	UNLOCKI			;CLEANUP AND GO HOME
	JRST POPAJ

IFN HNKLOG,[
PCOPHN:	SKIPN VHUNKP		;TREAT HUNKS AS LISTS IF HUNKP IS NIL
	 JRST PCOPLS
	PUSH P,A
	PUSH FXP,TT
	PUSHJ P,USRHNP		;Is this a user's extended object?
	POP FXP,TT
	JUMPE T,PCOPH5
	PUSH P,[QPURCOPY]
	MOVNI T,2
	XCT SENDI

PCOPH5:	POP P,A
PCOPH2:
   2DIF [HRRZ B,(TT)]GCWORN,QLIST
	PUSH P,B		.SEE INTXCT	;CAN'T USE FXP
   2DIF [AOSL B,(TT)]NPFFS,QLIST	;THIS WORD SERVES AS ARG TO GTNPSG
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVE D,B
	ADD D,(P)
	SOS D			;SINCE ALREADY AOS'ED ONCE
   2DIF [MOVEM D,(TT)]NPFFS,QLIST
   NOPRO
   2DIF [ADD B,(TT)]EPFFS,QLIST	;B NOW HAS ADDRESS OF FRESH PURE HUNK
	PUSH P,A
	PUSH P,B
	MOVE D,-2(P)
PCOPH3:	ADD D,-1(P)		;WE SCAN THE OLD HUNK FROM THE END BACKWARDS
	HLRZ B,-1(D)		;GOBBLE A CAR AND A CDR
	HRRZ A,-1(D)
	PUSH P,B
	PUSHJ P,PURCOPY		;PURCOPY THE CDR
	EXCH A,(P)
	PUSHJ P,PURCOPY		;PURCOPY THE CAR
	HRLM A,(P)
	MOVE D,-1(P)		;CALCULATE PLACE IN NEW HUNK
	ADD D,-3(P)
	POP P,-1(D)		;POP COPIED CAR/CDR PAIR INTO PURE HUNK
	SOSE D,-2(P)
	 JRST PCOPH3
	POP P,A			;RETURN NEW HUNK
	SUB P,R70+2
	POPJ P,

]		;END OF IFN HNKLOG

IFN PAGING,[

SUBTTL	GETCOR

;;; THIS ROUTINE IS SPECIFICALLY FOR PEOPLE WHO HAND-CODE LAP.
;;; IT IS USED TO ALLOCATE A NUMBER OF CONSECUTIVE PAGES
;;; OF MEMORY FOR VARIOUS PURPOSES, E.G. HACKING OF PDP-11'S
;;; OR INFERIOR JOBS OR WHATEVER.
;;; THE NUMBER OF PAGES DESIRED SHOULD BE IN TT; THE LOW ADDRESS
;;; OF THE PAGES IS RETURNED IN TT, OR ZERO FOR FAILURE.
;;; THIS ROUTINE DOES NOT ACTUALLY GET CORE; IT MERELY RESERVES
;;; ADDRESS SPACE.
;;; THERE IS CURRENTLY NO PROVISION FOR RETURNING THE MEMORY GRABBED.

GETCOR:	HLLOS NOQUIT
	LSH TT,PAGLOG
	MOVE T,HINXM
	SUBI T,(TT)
	CAMGE T,BPSH
	 JRST GTCOR6
	MOVEI F,(TT)		;GETTING F THIS WAY FLUSHES
	LSH F,-PAGLOG		; RANDOM BITS. (IT'S SAFER.)
GTCOR4:	PUSHJ P,ALIMPG
	 .VALUE			;HOW CAN WE LOSE HERE?
	SOJG F,GTCOR4
	SKIPA TT,HINXM
GTCOR6:	 TDZA TT,TT		;LOSE, LOSE, LOSE
	  ADDI TT,1
	JRST CZECHI



LHVB0:	WTA [BAD SIZE - LH↑<!]	;↑< = |
LHVBAR:	CAIL B,QLIST		;SUBR 2
	 CAILE B,QARRAY		;GROSS KLUDGE FOR LH
	  JRST LHVB1
	JSP T,FXNV1
	TLNE TT,-1
	 JRST LHVB0
	ADDI TT,PAGSIZ-1
	IDIVI TT,PAGSIZ
	MOVNI AR2A,(TT)
	PUSHJ P,GETCOR
	JUMPE TT,FIX1
	CAIE B,QARRAY
	 CAIN B,QRANDOM
	  XORI B,QARRAY#QRANDOM	;GROSS KLUDGE
	MOVEI D,(TT)
	LSH D,-SEGLOG
	IMULI AR2A,SGS%PG
	HRLI D,(AR2A)
   2DIF [MOVE R,(B)]GCWORS,QLIST
LHVB3:	MOVEM R,ST(D)
	SETZM GCST(D)
	TLNN R,$FS+BN+HNK
	 JRST LHVB4
	MOVE T,LHSGLK
	DPB T,[SEGBYT,,GCST(D)]
	HRRZM D,LHSGLK
LHVB4:	AOBJN D,LHVB3
	JRST FIX1

LHVB1:	EXCH A,B
	WTA [BAD SPACE - LH↑<!]	;↑< = |
	EXCH A,B
	JRST LHVBAR


;;;	IFN PAGING

SUBTTL	PDL OVERFLOW HANDLER

;;; CALL BY  JSR PDLSTH
;;; F HAS THE ADDRESS OF THE AC HOLDING THE PDL POINTER.
;;; D HAS AN ADDRESS WITHIN THE PAGE TO GET.
;;; R MAY BE USED AS SCRATCH.

;PDLSTH:	0		;HACK ST FOR ADDING PDL PAGES
PDLST0:
	LSH D,-PAGLOG
IFN ITS,[
	.CALL PDLST8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	MOVEM A,PDLSTA		;SAVE AWAY AC'S SO CAN DO A JSYS
	MOVEM B,PDLSTB
	MOVEM C,PDLSTC
	MOVEI 1,.FHSLF		;DISABLE INTERRUPT FOR OURSELVES
	MOVE 2,[<1←<35.-.ICNXP>>] ;WE CAN'T HANDLE THE NXP TRAP THIS WILL CAUSE
	DIC
	MOVEI 1,(D)		;PAGE NUMBER
	LSH 1,PAGLOG		;MAKE AN ADDRESS
	SETMM (1)		;CREATE THE PAGE
	MOVSI 1,.FHSLF		;CHANGE ACCESS FOR OUR PROCESS
	HRRI 1,(D)		;THE PAGE WE JUST CREATED
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
	MOVEI 1,.FHSLF		;REEANBLE NXP TRAPS
	MOVE 2,[<1←<35.-.ICNXP>>]
	AIC
	MOVE C,PDLSTC		;RESTORE AC'S
	MOVE B,PDLSTB
	MOVE A,PDLSTA
]		;END OF IFN D20
	MOVEI R,(D)		;CALCULATE PURTBL BYTE POINTER
	ROT R,-4
	ADDI R,(R)
	ROT R,-1
	TLC R,770000
	ADD R,[430200,,PURTBL]
	MOVSS D
	HRRI D,3
	DPB D,R				;UPDATE PURTBL
	LSH D,-22+PAGLOG-SEGLOG		;HORRIBLE HACKERY TO UPDATE ST
	ADD D,[-<SGS%PG+1>,,ST-1]	; WITHOUT AN EXTRA AC:
REPEAT SGS%PG, PUSH D,PDLST9-P(F)	; USE PUSHES! (CAN'T OVERFLOW)
	JRST @PDLSTH

IFN ITS,[
PDLST8:	SETZ
	SIXBIT \CORBLK\		;HACK PAGE MAP
	  1000,,%CBNDR+%CBNDW	;GET READ AND WRITE ACCESS
	  1000,,%JSELF		;FOR MYSELF
	      ,,D		;PAGE NUMBER
	401000,,%JSNEW		;GET FRESH PAGE
]		;END OF IFN ITS

;;;	IFN PAGING


;;; HAIRY PDL OVERFLOW HANDLER

PDLOV:	MOVE F,INTPDL
	MOVEM D,IPSWD2(F)	;SAVE D
	MOVEM R,IPSWD1(F)	;SAVE R
	SKIPL INTPDL
	 .VALUE			;I WANT TO SEE THIS! - GLS
	MOVEI F,P		;ALL RIGHT THEN, LET'S PLAY
	JUMPGE P,PDLH0A		; TWENTY QUESTIONS - IS IT REGPDL?
	MOVEI F,SP
	JUMPGE SP,PDLH0A	;SPECPDL?
	MOVEI F,FXP
	JUMPGE FXP,PDLH0A	;FXP?
	MOVEI F,FLP		;IF NOT FLP, THEN IT'S PRETTY RANDOM
	JUMPGE FLP,PDLH0A
	HLRZ R,NOQUIT
	JUMPN R,PDLH3A
	LERR [SIXBIT \RANDOM PDL OVERFLOW!\]

PDLH0A:	HRRZ R,(F)		;FETCH RIGHT HALF OF PDL POINTER
	MOVEI D,(R)
	CAML R,OC2-P(F)		;IF WE'RE OVER THE ORIGIN OF THE
	 JRST PDLH5		; OVERFLOW PDL, THEN ERROR OUT
	HLRZ R,F
	ADDI R,11(D)		;HERE IS A HACK TO PAGIFY
	IORI R,PAGSIZ-1		; UPWARDS, BUT KEEP WELL AWAY
	SUBI R,10		; FROM THE PAGE BOUNDARY
	CAML R,OC2-P(F)		;IF WE'RE ABOVE THE OVERFLOW PDL,
	 MOVE R,OC2-P(F)	; ONLY INCREASE TO THAT PLACE
	CAMGE D,ZPDL-P(F)	;SKIP IF WE'RE ABOVE PDLMAX
	 JRST PDLH2		; PARAMETER FOR THIS PDL
	TLO F,-1		;SET FLAG TO INDICATE THIS FACT
	MOVE D,MORPDL-P(F)	;PUSH UP THE PDLMAX
	ADD D,ZPDL-P(F)		; "SOME MORE"
	ANDI D,777760		;BUT KEEP AWAY FROM PAGE
	TRNN D,PAGKSM		; BOUNDARY (PICKY, PICKY!)
	 SUBI D,20
	MOVEM D,ZPDL-P(F)
	HRRZ D,(F)
	JRST PDLH2A

PDLH2:	TLZE F,-1
	 JRST PDLH2B
	CAMLE R,ZPDL-P(F)	;IF OUR GUESS WOULD PUT US OVER
PDLH2A:	 MOVE R,ZPDL-P(F)	; PDLMAX, GO ONLY AS FAR AS THAT
PDLH2B:	SUBI D,(R)		;CALCULATE NEW LEFT HALF FOR PDL PTR
	HRLM D,(F)		;CLOBBER INTO PDL PTR
	HRRZ D,(F)		;FIGURE OUT IF WE NEED TOP GET
	ADDI R,10		; MORE CORE FOR ALL THIS
	ANDI R,PAGMSK
	EXCH R,D
	CAIG R,(D)		;SKIP IF WE CROSSED NO PAGE BOUNDARY
	 JSR PDLSTH		;ELSE MUST GET NEW PAGE AND UPDATE ST
	TLZN F,-1		;SKIP IF WE WERE ABOVE PDLMAX
	 JRST PDLH3A
	MOVSI D,QREGPDL-P(F)
	HRRI D,1005		;PDL-OVERFLOW
	HRRZ R,INTPDL
	HRRZ R,IPSPC(R)
	CAIL R,UINT0		;AVOID DEEP INTERRUPT RECURSION:
	 CAILE R,EUINT0		; IF PDL OVERFLOWED WITHIN UINT0,
	  JRST PDLH4		; THEN JUST STACK UP THE INTERRUPT,
	JSR UISTAK		; AND SOMEONE WILL EVENTUALLY TRY CHECKI
PDLH3A:	HRRZ F,INTPDL
	JRST INTXT2


PDLH4:	MOVE R,FXP		;ELSE TRY TO GIVE A PDL OVERFLOW
	SKIPE GCFXP		; USER INTERRUPT IMMEDIATELY
	 MOVE FXP,GCFXP		;REMEMBER, PDL OVERFLOW IS NOT
	PUSH FXP,R		; DISABLED INSIDE THE PDL
	PUSHJ FXP,$IWAIT	; OVERFLOW HANDLER!!!
	 JRST XUINT
	JRST INTXIT
	

;;;	IFN PAGING

MORPDL:	400		;AMOUNTS TO INCREMENT PDLS BY
	100		; WHEN OVERFLOW OCCURS (THIS GIVES
	LSWS+100	; LOSER A CHANCE TO SSTATUS PDLMAX,
	200		; AT LEAST)

PDLMSG:	POVPDL		;REG
	POVFLP		;FLONUM
	POVFXP		;FIXNUM
	POVSPDL		;SPEC

PDLST9:	$XM,,QRANDOM		;TYPICAL ST ENTRIES FOR PDL PAGES
	FL+$PDLNM,,QFLONUM
	FX+$PDLNM,,QFIXNUM
	$XM,,QRANDOM

PDLH5:	IORI R,PAGSIZ-1		;BAD PDL OV - REALLY DESPERATE
	SUBI D,-2(R)		;GIVE US AS MUCH PDL AS IS LEFT
	JUMPL D,PDLH6
	MOVE P,C2
	MOVE FXP,FXC2
	SETZM TTYOFF
	STRT UNRECOV
	STRT @PDLMSG-P(F)
	JRST DIE

PDLH6:	HRLM D,(F)
	HLRZ R,NOQUIT
	JUMPN R,GCPDLOV		;FOO! HAPPENED IN GC - BOMB OUT!
	HRRZ B,PDLMSG-P(F)
	CAIE B,POVSPDL
	JRST PDLOV5		;PDLOV5 HANDLE WILL GET US TO TOP LEVEL
	MOVEM P,F		;FOR SP, TRY TO POP BINDINGS FIRST
	HRRZ TT,SPSV		; SO *RSET-TRAP WON'T OVERFLOW
	MOVE P,[-LFAKP-1,,FAKP]	;SO WE HAVE ENOUGH PDL FOR UBD
	PUSH P,FXP
	MOVE FXP,[-LFAKFXP-1,,FAKFXP]
	PUSHJ P,UBD
	POP P,FXP
	MOVE P,F
	JRST PDLOV5		;PDLOV5 WILL SET UP PDLS

]		;END OF IFN PAGING

SUBTTL	PURE SEGMENT CONSER

;;; GRBPSG RETURNS ONE PUREIFIABLE SEGMENT.  ADR IN AC T
;;; GTNPSG IS INVOKED AS FOLLOWS:
;;;		AOSL A,NPFF%	;SKIP UNLESS NO MORE LEFT
;;;	   SPECPRO INTPPC
;;;		PUSHJ P,GTNPSG	;MUST GET MORE
;;;		ADD A,EPFF%	;ELSE JUST FIGURE OUT ABSOLUTE ADDRESS
;;;	   NOPRO
;;; WHERE % IS SOME APPROPRIATE LETTER (E.G. S, X, L, B).
;;; GTNPSG UPDATES NPFF% AND EPFF% BY LOOKING AT THE AOSL, THEN
;;; RETURNS TO THE AOSL.

   XCTPRO
GRBPSG:	HLLOS NOQUIT		;GET NEW PURE SEGMENT
   NOPRO
	SAVEFX TT D R
	SKIPN T,PRSGLK		;SKIP IF ANY SEGMENTS IN PURE SEGMENT FREELIST
	 PUSHJ P,GTNPS3
	LDB D,[SEGBYT,,GCST(T)]	;IF SO, CDR THAT FREELIST
	MOVEM D,PRSGLK
	MOVE TT,[$XM+PUR,,QRANDOM]
	MOVEM TT,ST(T)		;SETUP ST TABLE CORRECTLY
	SETZM GCST(T)		;AND ALSO GCST
	RSTRFX R D TT
	JRST CZECHI

;GETS A PURE SEGMENT FOR CONSING PURPOSES
   XCTPRO
GTNPSG:	HLLOS NOQUIT		;GET NEW PURE SEGMENT
   NOPRO
REPEAT 2,	SOS (P)		;BACK UP RETURN ADDRESS TO PRECEDING INST
	SAVEFX T TT D R
	SKIPN T,PRSGLK		;SKIP IF ANY SEGMENTS IN PURE SEGMENT FREELIST
	 PUSHJ P,GTNPS3
	LDB D,[SEGBYT,,GCST(T)]	;IF SO, CDR THAT FREELIST
	MOVEM D,PRSGLK
IFE HNKLOG,	MOVE D,@(P)	;NOW D POINTS TO NPFF-
IFN HNKLOG,[
	MOVE D,(P)		;THIS ALLOWS REFERENCE TO NPFF- TO BE INDEXED
	MOVEI D,@(D)		; BY TT, WHICH MUST BE SAFE TO THIS POINT
]		;END OF IFN HNKLOG
   2DIF [SKIPN TT,(D)]GTNPS8,NPFFS
	 .VALUE
	MOVEM TT,ST(T)
	SETZM GCST(T)
	LSH T,SEGLOG
	ADDI T,SEGSIZ
	MOVEM T,EPFFS-NPFFS(D)	;UPDATE PARAMETERS FOR NEW PURE SEGMENT
	MOVNI T,SEGSIZ+1
	MOVEM T,(D)
	MOVEI T,SEGSIZ
	ADDM T,PFSSIZ-NPFFS(D)	;UPDATE STORAGE SIZE
	RSTRFX R D TT T
	JRST CZECHI

;;; TYPICAL ST ENTRIES FOR PURE SEGMENTS
GTNPS8:	LS+$FS+PUR,,QLIST		;LIST
	FX+PUR,,QFIXNUM			;FIXNUM
	FL+PUR,,QFLONUM			;FLONUM
DB$	DB+PUR,,QDOUBLE			;DOUBLE
CX$	CX+PUR,,QCOMPLEX		;COMPLEX
DX$	DX+PUR,,QDUPLEX			;DUPLEX
BG$	BN+PUR,,QBIGNUM			;BIGNUM
	0				;NO PURE SYMBOLS
HN$  REPEAT HNKLOG+1,  LS+HNK+PUR,,QHUNK0+.RPCNT 	;HUNKS
	0				;NO PURE SARS
IFN .-GTNPS8-NFF, WARN [GTNPS8 WRONG LENGTH TABLE]
	$XM+PUR,,QRANDOM		;SYMBOL BLOCKS

;CALLED TO GET NEW PAGE OF PURE MEMORY
;RETURNS C(PRSGLK) IN T
GTNPS3:	PUSH FXP,TT		;GTNPSG REQUIRES TT TO BE SAFE
IFN PAGING,[
	MOVE T,HINXM		;FIGURE OUT IF ANY ROOM LEFT
	SUBI T,PAGSIZ
	CAMGE T,BPSH
	 LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
	MOVEM T,HINXM		;UPDATE HINXM
	MOVEI TT,1(T)
]		;END OF IFN PAGING
IFE PAGING,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
	 LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
	MOVEM TT,HIXM
]		;END OF IFE PAGING
	LSH TT,-SEGLOG		;UPDATE ST AND GCST FOR NEW PAGE
	MOVE D,[$XM+PUR,,QRANDOM]
REPEAT SGS%PG, MOVEM D,ST+.RPCNT(TT)
	MOVE D,PRSGLK
REPEAT SGS%PG,[
	SETZM GCST+.RPCNT(TT)
	DPB D,[SEGBYT,,GCST+.RPCNT(TT)]
	MOVEI D,.RPCNT(TT)
]		;END OF REPEAT SGS%PG
	MOVEM D,PRSGLK
IFN PAGING,[
	MOVEI TT,1(T)		;UPDATE PURTBL
	ROT TT,-PAGLOG-4
	ADDI TT,(TT)
	ROT TT,-1
	TLC TT,770000
	ADD TT,[430200,,PURTBL]
	DPB T,TT		;T HAS 11 IN LOW TWO BITS
				; (CAN PURIFY, WITH SOME CARE)
IFN ITS,[
	MOVEI R,1(T)		;NOT AN AOBJN POINTER,
	LSH R,-PAGLOG		; SO WE GET ONLY ONE PAGE
	.CALL GTSPC8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	PUSHJ FXP,SAV3
	SETMM 1(T)		;CREATE THE PAGE
	MOVEI 1,1(T)		;THEN GET THE PAGE NUMBER
	LSH 1,-PAGLOG
	HRLI 1,.FHSLF
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
	PUSHJ FXP,RST3
]		;END OF IFN D20
]		;END OF IFN PAGING
IFN <PAGING-1>*D10,[
	HRRZ TT,HIXM
	CORE TT,
	 HALT
]		;END OF IFN <PAGING-1>*D10
	MOVE T,PRSGLK		;FORCE PRSGLK INTO AC T FOR CALLER
	POP FXP,TT
	POPJ P,


SUBTTL	FREE STORAGE SPACE EXPANSION

;;; THIS PORTION OF THE GARBAGE COLLECTOR DETERMINES WHETHER
;;; WE SHOULD JUST GRAB A NEW SEGMENT OF FREE STORAGE FOR SOME
;;; CONSER, OR DO A FULL-BLOWN GARBAGE COLLECTION. IT IS
;;; CONTROLLED BY PARAMETERS SETTABLE VIA (SSTATUS GCSIZE ...).

GCGRAB:	MOVN R,D
	JFFO R,.+1		;DETERMINE WHICH SPACE WANTED MORE
	SUBI F,NFF
	MOVEI AR2A,1		;MACRAK SEZ: GRAB JUST ONE
	SKIPN FFY2
	 SETZ F,
	JUMPE F,GCGRB1		; ... SEZ MACRAK
	MOVE D,SFSSIZ+NFF(F)
	CAML D,GFSSIZ+NFF(F)	;CAN'T JUST GRAB IF ABOVE SIZE
	 JRST AGC1Q		; SPECIFIED FOR "FREE GRABBIES"
	MOVE D,GFSSIZ+NFF(F)
	CAMLE D,XFFS+NFF(F)	;CAN'T GRAB IF IT WOULD PUT
	 JRST AGC1Q		; US ABOVE THE MAXIMUM SIZE
GCGRB1:	PUSH FXP,AR2A
	PUSHJ P,GRABWORRY
	POP FXP,AR1
	JUMPGE AR2A,AGC1Q	;GO DO FULL-BLOWN GC AFTER ALL
IFN WHL,[
	MOVE D,[-3,,GCWHL6]
	MOVE R,GCWHO
	TRNE R,1
	 .SUSET D
]		;END OF IFN WHL
	JRST GCEND

;;; THESE ROUTINES WORRY ABOUT GETTING A NEW IMPURE FREE STORAGE
;;; SEGMENT. (FOR PURE FREE STORAGE SEGMENTS, SEE GTNPSG.)
;;; GCWORRY MUST DO SPECIAL HACKERY FOR SYMBOL AND SAR SPACES, SINCE THEY
;;; REQUIRE MORE THAN ONE CONSECUTIVE SEGMENT, AND PRINTS OUT PRETTY
;;; MESSAGES IF GCGAG IS NON-NIL.  MUST HAVE NOQUIT NON-ZERO.
;;; *THE FOLLOWING COMMENT IS HISTORICAL AND SHOULD BE IGNORED*
;;; MUST HAVE NOQUIT NON-ZERO AND ST/GCST PAGES IMPURE WHEN ENTERING!

;THIS ROUTINE ALLOCATES ONE IMPURE SEGMENT AND MARKS IT AS
; $XM,,QRANDOM IN ST TABLE.  POINTER TO SEGMENT RETURNED IN TT
; DESTROYS C, D, AR1, R
GRBSEG:	SKIPE TT,IMSGLK
	 JRST GRBSG1		;JUMP IF ANY SEGMENTS AVAILABLE
	PUSHJ P,ALIMPG		;ELSE MUST GRAB A NEW PAGE
	 POPJ P,		;FAIL IF NO NEW PAGES TO BE HAD
GRBSG1:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR THE FREE SEGMENT LIST
	MOVE D,[$XM,,QRANDOM]	;MARK NEW SEGMENT IN ST TABLE
	MOVEM D,ST(TT)
	SETZM GCST(TT)		;RESET GCST TABLE ENTRY
	LSH TT,SEGLOG		;RETURN A POINTER TO THE HEAD OF THE SEGMENT
	AOS (P)
	POPJ P,

;THIS ROUTINE IS FOR NORMAL ALLOCATION OF SEGMENTS BY THE GC
GCWORRY:SUBI AR2A,(TT)		;ENTRY FOR GARBAGE COLLECTOR
	ADDI AR2A,SEGSIZ-1	;FIGURE OUT HOW MANY NEW SEGMENTS WE NEED
	LSH AR2A,-SEGLOG
GRABWORRY:
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	JUMPE F,.+2	;ENTRY FOR GCGRAB
	SKIPN GCGAGV		;MAYBE WE WANT A PRETTY MESSAGE?
	 SOJA AR2A,GCWOR2	;IF NOT, DECR AR2A (SEE BELOW)
	STRT 17,[SIXBIT \↑M;ADDING !\]
	SOJG AR2A,GCWR0A	;AR2A GETS DECR'ED HERE, TOO!
	STRT 17,[SIXBIT \A!\]	;KEEP THE ENGLISH GOOD
	JRST GCWR0B

GCWR0A:	MOVEI R,$TYO
	MOVEI TT,1(AR2A)
	PUSH FXP,AR2A
IFE USELESS,	MOVE C,@VBASE		;BASE DAMN WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	POP FXP,AR2A
GCWR0B:	STRT 17,[SIXBIT \ NEW !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SEGMENT!\]
	SKIPE AR2A
	 STRT 17,[SIXBIT \S!\]
GCWOR2:	SKIPE TT,IMSGLK
	 JRST GCWR2A		;JUMP IF ANY SEGMENTS AVAILABLE
	PUSHJ P,ALIMPG		;ELSE MUST GRAB A NEW PAGE
	 JRST GCWOR7
GCWR2A:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR THE FREE SEGMENT LIST
	MOVE D,FSSGLK+NFF(F)	;CONS NEW SEGMENT ONTO LIST
	MOVEM TT,FSSGLK+NFF(F)	; OF SEGMENTS FOR THE
	HRRZ R,BTBAOB		; PARTICULAR SPACE
	HLL R,GCWORS+NFF(F)
	LSH D,22-<SEGLOG-5>
GCWR2B:	TLNE R,$FS+FX+FL+BN+HNK+DB+CX+DX	.SEE GCWR2C
	 IORI D,(R)		;MAYBE ALLOCATE A BIT BLOCK FOR
	IOR D,GCWORG+NFF(F)	; THE NEW SEGMENT FOR USE BY
	MOVEM D,GCST(TT)	; GC IN MARKING CELLS
	MOVE D,GCWORS+NFF(F)	;UPDATE ST ENTRY FOR THE
	MOVEM D,ST(TT)		; NEW SEGMENT
	MOVE D,FFS+NFF(F)	;ADD CELLS OF SEGMENT TO
	LSH TT,SEGLOG		; THE FREE STORAGE
	MOVEM D,(TT)		; LIST FOR THIS SPACE
	MOVE D,[GCWORX,,1]
	BLT D,LPROG9
	HLL TT,GCWORN+NFF(F)
	HRR GCWRX1,GCWORN+NFF(F)
	HRRI GCWRX2,-1(GCWRX1)
	JRST GCWRX1

GCWR2C:	HRRZM TT,FFS+NFF(F)
	TLNN R,$FS+FX+FL+BN+HNK+DB+CX+DX	.SEE GCWR2B
	 JRST GCWR4Q
	HRRZ TT,BTBAOB		;DECIDE WHETHER THIS BIT BLOCK
	LSH TT,SEGLOG-5		; LIES IN MAIN BIT BLOCK AREA
	MOVEI D,-1(TT)
	CAME D,MAINBITBLT
	 JRST GCWR3A
	ADDI D,BTBSIZ		;YES - JUST UPDATE MAIN BLT
	MOVEM D,MAINBITBLT	; POINTER FOR CLEARING 
	JRST GCWR3B		; BIT BLOCKS (SEE GCINBT)

GCWR3A:	LSH TT,-SEGLOG		;ELSE AOS COUNT OF BIT BLOCKS
	AOS GCST(TT)		; IN CURRENT BIT BLOCK SEGMENT
GCWR3B:	MOVE TT,BTBAOB		;AOBJN THE BIT BLOCK
	AOBJN TT,GCWOR4		; ALLOCATION POINTER
	SKIPE TT,IMSGLK		;FOO! OUT OF BIT BLOCKS!
	 JRST GCWR3F
	PUSHJ P,ALIMPG		;FOO FOO! NEED NEW PAGE!
	 JRST GCWFOO
GCWR3F:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR LIST OF FREE SEGMENTS
	MOVE D,[$XM,,QRANDOM]	;UPDATE ST AND GCST FOR
	MOVEM D,ST(TT)		; NEW BIT BLOCK SEGMENT
	MOVEI D,(TT)		;GCST ENTRY IS USED TO
	LSH D,5			; INDICATE HOW MANY
	MOVEM D,GCST(TT)	; BLOCKS ARE IN USE
	MOVE D,BTSGLK		;CONS NEW SEGMENT ONTO LIST
	DPB D,[SEGBYT,,GCST(TT)]	; OF BIT BLOCK SEGMENTS
	MOVEM TT,BTSGLK
	LSH TT,5		;CALCULATE NEW BIT BLOCK
	HRLI TT,-SEGSIZ/BTBSIZ	; ALLOCATION POINTER
GCWOR4:	MOVEM TT,BTBAOB
GCWR4Q:	JUMPE F,GCWOR6
	MOVEI TT,SEGSIZ		;UPDATE VARIOUS GC PARAMETERS
	ADDM TT,NFFS+NFF(F)
	ADDB TT,SFSSIZ+NFF(F)
	CAMLE TT,XFFS+NFF(F)	;MUST STOP IF OVER MAX
	 SOJA AR2A,.+2		;KEEP COUNT ACCURATE
GCWOR6:	SOJGE AR2A,GCWOR2	;ALSO STOP IF WE GOT ALL WE WANT
GCWOR7:	JUMPE F,CPOPJ
	SKIPN GCGAGV		;MAYBE WANT MORE PRETTY MESSAGE
	 POPJ P,
	SKIPL AR2A
	 STRT 17,[SIXBIT \↑M; BUT DIDN'T SUCCEED!\]
	STRT 17,[SIXBIT \ -- !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SPACE NOW !\]
	MOVEI R,$TYO
	PUSH FXP,AR2A
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	MOVE TT,SFSSIZ+NFF(F)
IFE USELESS,	MOVE C,@VBASE
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	STRT 17,[SIXBIT \ WORDS!\]
	POP FXP,AR2A
	POPJ P,

;;; TYPICAL GCST ENTRIES FOR IMPURE SPACES
GCWORG:	GCBMRK+GCBCDR+GCBCAR,,			;LIST
	GCBMRK,,				;FIXNUM
	GCBMRK,,				;FLONUM
DB$	GCBMRK,,				;DOUBLE
CX$	GCBMRK,,				;COMPLEX
DX$	GCBMRK,,				;DUPLEX
BG$	GCBMRK+GCBCDR,,				;BIGNUM
	GCBMRK+GCBSYM,,				;SYMBOL
HN$  REPEAT HNKLOG+1, GCBMRK+GCBCDR+GCBCAR+GCBHNK,,	;HUNKS
	GCBMRK+GCBSAR,,				;SAR
IFN .-GCWORG-NFF, WARN [WRONG LENGTH TABLE]
	0					;SYMBOL BLOCKS

;;; TYPICAL ST ENTRIES FOR IMPURE SPACES
GCWORS:	LS+$FS,,QLIST				;LISP
	FX,,QFIXNUM				;FIXNUM
	FL,,QFLONUM				;FLONUM
DB$	DB,,QDOUBLE				;DOUBLE
CX$	CX,,QCOMPLEX				;COMPLEX
DX$	DX,,QDUPLEX				;DUPLEX
BG$	BN,,QBIGNUM				;BIGNUM
	SY,,QSYMBOL				;SYMBOL
HN$  REPEAT HNKLOG+1, LS+HNK,,QHUNK0+.RPCNT		;HUNKS
	SA+$XM,,QARRAY				;SAR
IFN .-GCWORS-NFF, WARN [WRONG LENGTH TABLE]
	$XM,,QRANDOM				;SYMBOL BLOCKS

GCWFOO:	STRT [SIXBIT \↑M;GLEEP#! OUT OF BIT BLOCKS!\]
	JRST GCWOR7

GCWORX:			;EXTEND FREELIST THROUGH NEW SEGMENT
OFFSET 1-.
GCWRX1:	HRRZM TT,.(TT)	;OCCUPIES A,B,C,AR1 - MUST SAVE AR2A
GCWRX2:	ADDI TT,.
	AOBJN TT,GCWRX1
	JRST GCWR2C
LPROG9==:.-1
OFFSET 0
.HKILL GCWRX1 GCWRX2

GCWORN:	-SEGSIZ+1,,1				;LIST
	-SEGSIZ+1,,1				;FIXNUM
	-SEGSIZ+1,,1				;FLONUM
DB$	-SEGSIZ/2+1,,2				;DOUBLE
CX$	-SEGSIZ/2+1,,2				;COMPLEX
DX$	-SEGSIZ/2+1,,4				;DUPLEX
BG$	-SEGSIZ+1,,1				;BIGNUM
	-SEGSIZ+1,,1				;SYMBOL
HN$ 	REPEAT HNKLOG+1, -SEGSIZ/<1←.RPCNT>+1,,1←.RPCNT	;HUNKS
	-SEGSIZ/2+1,,2				;ARRAY SARS
IFN .-GCWORN-NFF, WARN [WRONG LENGTH TABLE]
	-SEGSIZ/2+1,,2				;SYMBOL BLOCKS

SUBTTL	IMPURE PAGE GOBBLER

;;; ALLOCATE AN IMPURE PAGE FREE STORAGE USE

ALIMPG:
IFN PAGING,[
	MOVE TT,HINXM		;MUST SAVE AR2A AND F FOR GCWORRY
	SUBI TT,PAGSIZ
	CAMGE TT,BPSH
]		;END OF IFN PAGING
IFE PAGING,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
]		;END OF IFE PAGING
	 POPJ P,		;NO PAGES LEFT - RETURN WITHOUT SKIP
IFN PAGING,[
	MOVEM TT,HINXM		;ELSE UPDATE HINXM
IFN ITS,[
	MOVEI R,1(TT)
	LSH R,-PAGLOG
	.CALL GTSPC8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	SETMM 1(TT)		;CREATE THE PAGE
	MOVEI 1,1(TT)
	LSH 1,-PAGLOG
	HRLI 1,.FHSLF
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
]		;END OF IFN D20
	MOVEI D,1(TT)		;COMPUTE A MAGIC BYTE POINTER
	LSH D,-PAGLOG
	ROT D,-4
	ADDI D,(D)
	ROT D,-1
	TLC D,770000
	ADD D,[430200,,PURTBL]
	MOVEI C,1
	DPB C,D			;UPDATE THE PURTBL
	HRRZ R,(P)		;GET THE CALLER'S PC+1
	CAIN R,GTCOR4+1		;DON'T HACK IMSGLK FOR GETCOR
	 JRST POPJ1
]		;END OF IFN PAGING
IFN <PAGING-1>*D10,[
	MOVEM TT,HIXM
	CORE TT,
	 HALT
	MOVE TT,HIXM
]		;END OF IFN <PAGING-1>*D10
	LSH TT,-SEGLOG
IFN PAGING, ADDI TT,SGS%PG
	MOVE C,IMSGLK		;UPDATE ST AND GCST, AND ADD
	MOVE AR1,[$XM,,QRANDOM]	; NEW SEGMENTS TO IMSGLK LIST
	MOVEI D,SGS%PG
ALIMP3:	MOVEM AR1,ST(TT)
	SETZM GCST(TT)
	DPB C,[SEGBYT,,GCST(TT)]
	MOVEI C,(TT)
	SOSE D
	 SOJA TT,ALIMP3
	MOVEM TT,IMSGLK		;EXITS WITH LOWEST NEW SEGMENT # IN TT
	JRST POPJ1		;WINNING RETURN SKIPS

SUBTTL	RECLAIM FUNCTION

IFN BIGNUM+USELESS,[

RECLAIM:	HRRZS A		;SUBR 2
	JUMPE A,CPOPJ		;GC A PARTICULAR SEXP
	LOCKI
	PUSHJ P,RECL1
	MOVEI A,NIL
	UNLKPOPJ


RECL1:	SKOTT A,LS+PUR
    2DIF JRST (TT),RECL9-1,QLIST	.SEE STDISP
	TLNE TT,HNK+VC+PUR	;DON'T RECLAIM VALUE CELLS!!! (OR HUNKS)
	 POPJ P,			; - ALSO DON'T RECLAIM PURE WORDS
	PUSH P,A		;SAVE ARG
	JUMPE B,RECL2		;B=NIL => RECLAIM ONLY TOP LEVEL OF LIST
	HLRZ A,(A)		;RECLAIM CAR
	PUSHJ P,RECL1
RECL2:	MOVE T,FFS
	POP P,FFS
	EXCH T,@FFS		;RECLAIM ONE CELL
	MOVEI A,(T)		;AND THEN GO AFTER THE CDR
	JRST RECL1

RECLFW:	JUMPE B,RECL9A		;B=NIL => DON'T RECLAIM FULLWORDS
	TLNE TT,$PDLNM		;DON'T RECLAIM PDL LOCATIONS!!!
	 POPJ P,
   2DIF [MOVE T,(TT)]FFS-QLIST	;RECLAIM NUMBER
	MOVEM T,(A)
   2DIF [MOVEM A,(TT)]FFS-QLIST
	POPJ P,

IFN BIGNUM,[
REBIG:	MOVE T,FFB		;RECLAIM BIGNUM HEADER
	EXCH T,(A)
	MOVEM A,FFB
	MOVEI A,(T)		;RECLAIM CDR OF BIGNUM
	JRST RECL1
]		;END OF IFN BIGNUM

RECL9:	JRST RECLFW	;FIXNUM
	JRST RECLFW	;FLONUM
DB$	JRST RECLFW	;DOUBLE
CX$	JRST RECLFW	;COMPLEX
DX$	JRST RECLFW	;DUPLEX
BG$	JRST REBIG	;BIGNUM
RECL9A:	POPJ P,		;SYMBOL
HN$  REPEAT HNKLOG+1, .VALUE	;HUNKS
	POPJ P,		;RANDOM
	POPJ P,		;ARRAY
IFN .-RECL9-NTYPES+1, WARN [WRONG LENGTH TABLE]

]		;END OF IFN BIGNUM+USELESS

IFN PAGING,[

SUBTTL	VALUE CELL AND SYMBOL BLOCK HACKERY

;;; ROUTINE TO GET MORE VALUE CELL SPACE.
;;; EXPANDS VALUE CELL SPACE BY GETTING NEXT PAGE IN THE HOLE
;;; LEFT FOR THIS PURPOSE, AND EXTENDING THE VALUE CELL FREELIST.
;;; IF NO PAGES LEFT IN THE HOLE, A LIST CELL IS USED.
;;; MAY CLOBBER ONLY A AND TT.

   XCTPRO
MAKVC3:	HLLOS NOQUIT
   NOPRO
	SOSL NFVCP
	 JRST MAKVC4
	PUSHJ P,CZECHI
	PUSHJ P,CONS1
	SETOM ETVCFLSP
	JRST MAKVC1

MAKVC4:
IFN ITS,[
	PUSH FXP,R		;MUST SAVE R
	MOVE R,EFVCS
	LSH R,-PAGLOG
	.CALL GTSPC8		;GET A NEW PAGE
	 .LOSE 10000
	POP FXP,R
]		;END OF IFN ITS	
IFN D20,[
	PUSHJ FXP,SAV3
	MOVE 1,EFVCS
	SETMM (1)		;CREATE THE PAGE
	LSH 1,-PAGLOG
	HRLI 1,.FHSLF
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
	PUSHJ FXP,RST3
]		;END OF IFN D20
	MOVE A,EFVCS
	MOVEM A,FFVC
	LSH A,-SEGLOG
	MOVE TT,[LS+VC,,QLIST]
REPEAT SGS%PG, MOVEM TT,ST+.RPCNT(A)	;UPDATE SEGMENT TABLE
	MOVSI TT,GCBMRK+GCBVC
REPEAT SGS%PG, MOVEM TT,GCST+.RPCNT(A)	;UPDATE GC SEGMENT TABLE
	LSH A,-PAGLOG+SEGLOG		;UPDATE PURTBL
	ROT A,-4
	ADDI A,(A)
	ROT A,-1
	TLC A,770000
	ADD A,[430200,,PURTBL]
	MOVEI TT,1
	DPB TT,A
	AOS TT,EFVCS		;EXTEND FREELIST THROUGHOUT NEW PAGE
	HRLI TT,-PAGSIZ+1
	HRRZM TT,-1(TT)
	AOBJN TT,.-1
	HRRZM TT,EFVCS
MAKVC8:	PUSHJ P,CZECHI
	JRST MAKVC0

]		;END OF IFN PAGING


;;; SYMBOL BLOCK COPYING ROUTINE - TRIGGERED BY PURE PAGE TRAP, OR EXPLICIT CHECK
;;;	B POINTS TO OLD SYMBOL BLOCK
;;;	LEAVES POINTER TO NEW SYMBOL BLOCK IN B
;;;	CLOBBERS TT, LEAVES POINTER TO VALUE CELL IN A

LDPRG9:	TLCA B,LDPARG		;FASLOAD CLOBBERING ARGS PROP
ARGCL7:	TLC B,ARGCL3		;ARGS CLOBBERING ARGS PROP
	HRRZ A,(B)
	JRST MAKVC6

MAKVC9:	TLC B,MAKVCX		;MAKVC CLOBBERING IN VALUE CELL
	JRST MAKVC6
MAKVC5:	PUSH P,SPSV		;MUST PRESERVE SPSV AS WE CAN COME HERE FROM
				; WITHIN A BIND AND AGC DOES BINDING ALSO
	PUSHJ P,AGC
	POP P,SPSV
   BAKPRO
MAKVC6:	SKIPN FFY2		;COME HERE IF HRRM ABOVE CAUSES
	 JRST MAKVC5		; A PURE PAGE TRAP - MUST COPY
	MOVE TT,@FFY2		; SYMBOL BLOCK FOR THAT SYMBOL
   XCTPRO
	EXCH TT,FFY2
   NOPRO
	HRLI A,SY.ONE\SY.CCN\SY.OTC ;ASSUME COMPILED CODE NEEDS IT FOR OTHER
				; THEN CALL UUO'S
	MOVEM A,SYMVC(TT)	; (THINK ABOUT THIS SOME MORE)
	MOVE A,SYMPNAME(B)
	MOVEM A,SYMPNAME(TT)
	HRRZ A,(TT)
	HRLM TT,@(P)
	EXCH TT,B
	HLRZ TT,TT
	JRST (TT)



SUBTTL	ALLOC FUNCTION

$ALLOC:	CAIE A,TRUTH		;SUBR 1 - DYNAMIC ALLOC
	 JRST $ALLC5
	SETO F,			;ARG=T => MAKE UP LIST
	EXCH F,INHIBIT		;CROCKISH LOCKI - DOESN'T MUNG FXP
	MOVNI R,NFF
$ALLC6:	PUSH FXP,GFSSIZ+NFF(R)	;SAVE UP VALUABLE DATA
	PUSH FXP,XFFS+NFF(R)	;LOCKI KEEPS IT CONSISTENT
	PUSH FXP,MFFS+NFF(R)
	AOJL R,$ALLC6
IFN PAGING, REPEAT 4,	PUSH FXP,XPDL+.RPCNT
	MOVEM F,INHIBIT		;EQUALLY CROCKISH UNLOCKI
	PUSHJ P,CHECKI
	PUSH P,R70
IFN PAGING,[
	MOVEI R,4
$ALLC9:	POP FXP,TT
	SUB TT,C2-1(R)
	TLZ TT,-1
	JSP T,FIX1A
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QREGPDL-1(R)
	PUSHJ P,XCONS
	MOVEM A,(P)
	SOJG R,$ALLC9
]		;END OF IFN PAGING
	MOVEI R,NFF
$ALLC7:	SKIPN SFSSIZ-1(R)
	 JRST $ALLC8		;SPACE SIZE IS ZERO - IGNORE IT
	POP FXP,TT
	PUSHJ P,SSGP2A
	PUSHJ P,NCONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QLIST-1(R)
	CAIN B,QRANDOM
	 MOVEI B,QARRAY
	PUSHJ P,XCONS
	MOVEM A,(P)
	JRST $ALLC4

$ALLC8:	SUB FXP,R70+3		;FLUSH GARBAGE
$ALLC4:	SOJG R,$ALLC7
	JRST POPAJ


$ALLC0:	HRRZ A,(AR2A)
$ALLC5:	JUMPE A,TRUE		;DECODE LIST OF PAIRS
	HLRZ B,(A)		;ARG IS LIST OF SAME FORM AS
	HRRZ AR2A,(A)		; A .LISP. (INIT) COMMENT
	HLRZ C,(AR2A)
	CAIL B,QREGPDL
	 CAILE B,QSPECPDL
	  JRST $ALLC3
	MOVEI D,1←-1		;SSPDLMAX
	PUSHJ P,SSGP3$
	JRST $ALLC0

$ALLC3:	JSP R,SFRET
	 JRST $ALLC0
	 JRST $ALLC0
	SETZ AR1,
	MOVEI F,(C)
	SKOTT C,LS
	 JRST $ALLC2
	HRRZ AR1,(C)
	HLRZ C,(C)
	HLRZ F,(AR1)
	SKIPE AR1
	 SKIPA AR1,(AR1)
	  SKIPA F,C
	   HLRZ AR1,(AR1)
$ALLC2:	MOVEI D,3←-1		;SSGCSIZE
	PUSHJ P,SSGP3$
	MOVEI C,(F)
	MOVEI D,5←-1		;SSGCMAX
	PUSHJ P,SSGP3$
	MOVEI C,(AR1)
	MOVEI D,7←-1		;SSGCMIN
	PUSHJ P,SSGP3$
	JRST $ALLC0


	PGTOP BIB,[MEMORY MANAGEMENT STUFF]

β